> import CPS



> main                  =  print (allSolutions fourColor ())


Coloring a planar map

Four colours are sufficient to color any planar map.


> data Colour           =  Red | Yellow | Blue | White
>                       deriving (Eq, Ord, Enum, Text)


The program is written in a Prolog-like style. The only sad thing is that we must explicate the binding modes of the predicates used.


> differentFF           =  unit (Red,    Yellow)
>                       ?? unit (Red,    Blue)
>                       ?? unit (Red,    White)
>                       ?? unit (Yellow, Red)
>                       ?? unit (Yellow, Blue)
>                       ?? unit (Yellow, White)
>                       ?? unit (Blue,   Red)
>                       ?? unit (Blue,   Yellow)
>                       ?? unit (Blue,   White)
>                       ?? unit (White,  Red)
>                       ?? unit (White,  Yellow)
>                       ?? unit (White,  Blue)



> differentBF Red       =  unit Yellow
>                       ?? unit Blue
>                       ?? unit White
> differentBF Yellow    =  unit Red
>                       ?? unit Blue
>                       ?? unit White
> differentBF Blue      =  unit Red
>                       ?? unit Yellow
>                       ?? unit White
> differentBF White     =  unit Red
>                       ?? unit Yellow
>                       ?? unit Blue



> differentBB c1 c2     =  guard (c1/=c2)


The function fourColor colors a simple map (taken from Sterling, Shapiro, The Art of Prolog).


> fourColor             =  differentFF                  &= \ (a,b) ->
>                          differentBF a                &= \ c     ->
>                          differentBF a                &= \ d     ->
>                          differentBB b c              &
>                          differentBF b                &= \ e     ->
>                          differentBB c d              &               
>                          differentBB c e              &
>                          differentBF c                &= \ f     ->
>                          differentBB d f              &
>                          differentBB e f              &
>                          unit [a,b,c,d,e,f]


Of course, differentFF and differentBF could have been defined more succinctly.


> differentFF'          =  alternate [ unit (c1,c2)
>                                    | c1<-[Red..White], c2<-[Red..White], c1/=c2 ]
> differentBF' c1       =  alternate [ unit c2
>                                    | c2<-[Red..White], c1/=c2 ]