Commit fd19a5e6 authored by Katja Bercic's avatar Katja Bercic

Add new file

parent bd5e96db
% Map Coloring
% Original problem: https://www.tjhsst.edu/~rlatimer/assignments2004/colors.txt
% It's known that only 4 colors are needed to paint any map so that no two neighboring states have the same color.
% Write a Prolog program that receives a map and a list of 4 colors and produces a colored map.
% The map is represented by a list of states, each of which is a state name and a list of neighboring states.
% For example, the maps of Australia and Western Europe are represented by the following maps.
% Maps of Australia and West Europe, colors, define getcolor
map('Australia',
[wa: [nt,sa], nt: [wa,sa,qld], qld:[nt,sa,nsw],
nsw: [qld,sa,vic], vic: [sa,nsw], tas:[],
sa: [wa,nt,qld,nsw,vic]]).
map('West Europe',
[portugal: [spain],
spain: [portugal, france],
belgium: [france, holland, luxembrg, germany],
holland: [belgium, germany],
luxembrg: [france, belgium, germany],
switzerld: [france,germany,austria, italy],
italy: [france,switzerld, austria],
austria: [germany, switzerld, italy],
france: [spain,belgium,luxembrg, germany,switzerld, italy],
germany:[holland,belgium,luxembrg,france,switzerld, austria]]).
colors([red,green,blue,yellow]).
% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
% Edit section
arrangecolors([],_,ColoredMap,ColoredMap).
% Tracing:
% :- write('Colormap='), write(ColoredMap),nl.
arrangecolors([Country:Neighbors|Rest], ColorList, TempList, ColoredMap) :-
member(Color,ColorList),
% Tracing:
% write('Color:'), write(Color),write(' TempList:'), write(TempList),nl,
different(Color,Neighbors,TempList)
arrangecolors(Rest,ColorList,[Country:Color|TempList], ColoredMap).
% TempList is in the format [country1:color1,country2:color2,...]
restrictedness(Neighbors,TempList,R) :-
length(Neighbors,1),
length(TempList,1),
R = 1.
% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
% Maybe useful things
findneighbors(X, Map, Who) :-
map(Map, Countries),
neighbors(X,Countries,Who).
neighbors(_,[],[]).
neighbors(X,[X:Neighbors|_], Neighbors) :- !. % Try this without the !
neighbors(X,[_|RestofCountries], Neighbors) :-
neighbors(X,RestofCountries, Neighbors).
adjacent(X,Y,Map) :-
findneighbors(X, Map, Countries),
member(Y, Countries).
% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
% This you will most likely use
different(C, Nbs, [S1:C1|Rest]) :-
not((member(S1,Nbs), C = C1)),
different(C, Nbs,Rest).
different(_,_,[]).
availablecolors(_,[],Colors,Colors).
availablecolors(Neighbors,[NB:Color|TempListTail],TempColors,Colors) :-
member(NB,Neighbors) ->
availablecolors(Neighbors,TempListTail,[Color|TempColors],Colors);
availablecolors(Neighbors,TempListTail,TempColors,Colors).
countrieswithconstraints([],_,L,L).
countrieswithconstraints([Country:Neighbors|Rest],TempList,Accumulator,CountriesWithConstraints) :-
countrieswithconstraints(Rest,TempList,[R-(Country:Neighbors)|Accumulator],CountriesWithConstraints),
restrictedness(Neighbors,TempList,R).
sortedcountries(Countries,TempList,SortedCountries) :-
countrieswithconstraints(Countries,TempList,[],CountriesWithConstraints),
keysort(CountriesWithConstraints,SortedCountries).
% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
% Main
paint(Map,ColoredMap) :-
map(Map, Countries),
colors(ColorList),
% Tracing:
% write('ColoredMap is '), write(ColoredMap), nl.
arrangecolors(Countries,ColorList,[], ColoredMap).
% paint('Australia',ColoredMap).
\ No newline at end of file
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment