Problem 86b

Use the Welsh-Powell algorithm to color a graph with the minimum number of colors.

Unit Test

import Html
import List
import Set


{-| A node has a value, degree and a color
-}
type alias Node comparable =
    ( comparable, Int, Int )


type alias Edge comparable =
    ( comparable, comparable, Int )


type alias Graph comparable =
    ( List (Node comparable), List (Edge comparable) )


{-| 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 ) =
    -- your implemenation goes here
    ( nodes, edges )


main : Html.Html a
main =
    Html.text
        <| case test of
            0 ->
                "Your implementation passed all tests."

            1 ->
                "Your implementation failed one test."

            x ->
                "Your implementation failed " ++ (toString x) ++ " tests."


test : Int
test =
    List.length
        <| List.filter ((==) False)
            [ testColor graph84 (colorize graph84)
            , testColor graph80 (colorize graph80)
            , testColor ( [], [] ) (colorize ( [], [] ))
            ]


{-| Given a graph, return true if it properly colored.
   * The graph must have no more than 4 colors,
   * All neighboring nodes must have different colors
-}
testColor : Graph comparable -> Graph comparable -> Bool
testColor ( n1, e1 ) ( nodes, edges ) =
    let
        lessThan5 =
            List.all (\( v, d, c ) -> (c > 0) && (c < 5)) nodes  

        neighborsDiffer =
            List.all (\( ca, cb ) -> ca /= cb)
                <| List.map (\( a, b, w ) -> ( (colorOfNode a nodes), (colorOfNode b nodes) )) edges                
        eTest = List.map (\(a,b,w) -> (a,b)) 
        nTest = List.map (\(v,d,c) -> v) 
    in
        List.all ((==) True)
            [ lessThan5
            , neighborsDiffer
            , (eTest e1) == (eTest edges)
            , List.sort (nTest n1) == List.sort (nTest nodes)
            ]


colorOfNode : comparable -> List (Node comparable) -> Int
colorOfNode v nodes =
    case nodes of
        [] ->
            0

        ( vv, d, c ) :: ns ->
            if v == vv then
                c
            else
                colorOfNode v ns


graph80 =
    ( [ ( 'b', 2, 0 )
      , ( 'c', 2, 0 )
      , ( 'd', 0, 0 )
      , ( 'f', 3, 0 )
      , ( 'g', 1, 0 )
      , ( 'h', 1, 0 )
      , ( 'k', 1, 0 )
      ]
    , [ ( 'b', 'c', 5 )
      , ( 'b', 'f', 8 )
      , ( 'c', 'f', 9 )
      , ( 'f', 'k', 17 )
      , ( 'g', 'h', 15 )
      ]
    )


graph81 =
    -- has a loop and parallel edges
    ( [ ( 'b', 2, 0 )
      , ( 'c', 2, 0 )
      , ( 'd', 0, 0 )
      , ( 'f', 3, 0 )
      , ( 'g', 4, 0 )
      , ( 'h', 2, 0 )
      , ( 'k', 1, 0 )
      ]
    , [ ( 'b', 'c', 5 )
      , ( 'b', 'f', 8 )
      , ( 'c', 'f', 9 )
      , ( 'f', 'k', 17 )
      , ( 'g', 'h', 15 )
      , ( 'g', 'h', 14 )
      , ( 'g', 'g', 15 )
      ]
    )


graph84 =
    ( [ ( 'b', 3, 0 )
      , ( 'c', 2, 0 )
      , ( 'd', 0, 0 )
      , ( 'f', 4, 0 )
      , ( 'g', 3, 0 )
      , ( 'h', 1, 0 )
      , ( 'k', 1, 0 )
      ]
    , [ ( 'b', 'c', 5 )
      , ( 'b', 'f', 8 )
      , ( 'b', 'g', 9 )
      , ( 'c', 'f', 9 )
      , ( 'f', 'g', 13 )
      , ( 'f', 'k', 17 )
      , ( 'g', 'h', 15 )
      ]
    )

Solution

Solution