Problem 86b

{-| Given a graph return a graph with the node colors set
    with the minimum number of colors (using the Welsh-Powell algorithm)
-}
colorize : Graph comparable -> Graph comparable
colorize ( nodes, edges ) =
    let
        defColor =
            List.length nodes

        ( ns, es ) =
            sortByDegree
                <| degree defColor ( nodes, edges )
    in
        colorize_ ( ns, es )


{-| Given a graph return a graph with the node colors set
    with the minimum number of colors (using the Welsh-Powell algorithm)
-}
colorize_ : Graph comparable -> Graph comparable
colorize_ ( nodes, edges ) =
    let
        ( colored, uncolored ) =
            List.partition (\( v, d, c ) -> c < List.length nodes) nodes
    in
        case uncolored of
            [] ->
                ( colored, edges )

            ( v, d, c ) :: ns ->
                let
                    colorNode =
                        ( v, d, lowColor v ( nodes, edges ) )

                    nodes_ =
                        colored ++ (colorNode :: ns)
                in
                    colorize_ ( nodes_, edges )


{-| Given a node and a graph, find the lowest color not used by any neighboring node
    so we can color a graph.
-}
lowColor : comparable -> Graph comparable -> Int
lowColor n ( nodes, edges ) =
    let
        values =
            Set.toList
                <| Set.remove n
                <| Set.fromList
                <| List.concatMap (\( a, b, w ) -> [ a, b ])
                <| List.filter (\( a, b, w ) -> (a == n) || (b == n)) edges

        neighborNodes =
            List.filter (\( v, d, c ) -> List.member v values) nodes

        neighborColors =
            List.map (\( v, d, c ) -> c) neighborNodes
    in
        lowestMissingInt 1 neighborColors


lowestMissingInt : Int -> List Int -> Int
lowestMissingInt start list =
    if List.member start list then
        lowestMissingInt (start + 1) list
    else
        start


{-| Given a graph return a graph with the sorted from highest to lowest degree
-}
sortByDegree : Graph comparable -> Graph comparable
sortByDegree ( nodes, edges ) =
    ( List.reverse (List.sortBy (\( n, d, c ) -> d) nodes), edges )


{-| Given a graph return a graph with the degree of each node correctly set
   so we can color the graph with the minimum number of colors,
   set all nodes to default high color
-}
degree : Int -> Graph comparable -> Graph comparable
degree defColor ( nodes, edges ) =
    let
        endPoints =
            List.concatMap (\( a, b, w ) -> [ a, b ]) edges

        nodes_ =
            List.map (\( n, d, c ) -> ( n, (countMembers n endPoints), defColor )) nodes
    in
        ( nodes_, edges )


countMembers : a -> List a -> Int
countMembers value list =
    List.length <| List.filter ((==) value) list

Back to problem