colorboard.pl

人工智能方面的例子：启发搜索的方法实现COLORBOARD的识别

/* The game moves */
left([A,empty,C,D,E,F,G,H,I,J,K,L],[empty,A,C,D,E,F,G,H,I,J,K,L]).
left([A,B,empty,D,E,F,G,H,I,J,K,L],[A,empty,B,D,E,F,G,H,I,J,K,L]).
left([A,B,C,empty,E,F,G,H,I,J,K,L],[A,B,empty,C,E,F,G,H,I,J,K,L]).
left([A,B,C,D,E,empty,G,H,I,J,K,L],[A,B,C,D,empty,E,G,H,I,J,K,L]).
left([A,B,C,D,E,F,empty,H,I,J,K,L],[A,B,C,D,E,empty,F,H,I,J,K,L]).
left([A,B,C,D,E,F,G,empty,I,J,K,L],[A,B,C,D,E,F,empty,G,I,J,K,L]).
left([A,B,C,D,E,F,G,H,I,empty,K,L],[A,B,C,D,E,F,G,H,empty,I,K,L]).
left([A,B,C,D,E,F,G,H,I,J,empty,L],[A,B,C,D,E,F,G,H,I,empty,J,L]).
left([A,B,C,D,E,F,G,H,I,J,K,empty],[A,B,C,D,E,F,G,H,I,J,empty,K]).

down([empty,B,C,D,E,F,G,H,I,J,K,L],[E,B,C,D,empty,F,G,H,I,J,K,L]).
down([A,empty,C,D,E,F,G,H,I,J,K,L],[A,F,C,D,E,empty,G,H,I,J,K,L]).
down([A,B,empty,D,E,F,G,H,I,J,K,L],[A,B,G,D,E,F,empty,H,I,J,K,L]).
down([A,B,C,empty,E,F,G,H,I,J,K,L],[A,B,C,H,E,F,G,empty,I,J,K,L]).
down([A,B,C,D,empty,F,G,H,I,J,K,L],[A,B,C,D,I,F,G,H,empty,J,K,L]).
down([A,B,C,D,E,empty,G,H,I,J,K,L],[A,B,C,D,E,J,G,H,I,empty,K,L]).
down([A,B,C,D,E,F,empty,H,I,J,K,L],[A,B,C,D,E,F,K,H,I,J,empty,L]).
down([A,B,C,D,E,F,G,empty,I,J,K,L],[A,B,C,D,E,F,G,L,I,J,K,empty]).

right([empty,B,C,D,E,F,G,H,I,J,K,L],[B,empty,C,D,E,F,G,H,I,J,K,L]).
right([A,empty,C,D,E,F,G,H,I,J,K,L],[A,C,empty,D,E,F,G,H,I,J,K,L]).
right([A,B,empty,D,E,F,G,H,I,J,K,L],[A,B,D,empty,E,F,G,H,I,J,K,L]).
right([A,B,C,D,empty,F,G,H,I,J,K,L],[A,B,C,D,F,empty,G,H,I,J,K,L]).
right([A,B,C,D,E,empty,G,H,I,J,K,L],[A,B,C,D,E,G,empty,H,I,J,K,L]).
right([A,B,C,D,E,F,empty,H,I,J,K,L],[A,B,C,D,E,F,H,empty,I,J,K,L]).
right([A,B,C,D,E,F,G,H,empty,J,K,L],[A,B,C,D,E,F,G,H,J,empty,K,L]).
right([A,B,C,D,E,F,G,H,I,empty,K,L],[A,B,C,D,E,F,G,H,I,K,empty,L]).
right([A,B,C,D,E,F,G,H,I,J,empty,L],[A,B,C,D,E,F,G,H,I,J,L,empty]).

up([A,B,C,D,empty,F,G,H,I,J,K,L],[empty,B,C,D,A,F,G,H,I,J,K,L]).
up([A,B,C,D,E,empty,G,H,I,J,K,L],[A,empty,C,D,E,B,G,H,I,J,K,L]).
up([A,B,C,D,E,F,empty,H,I,J,K,L],[A,B,empty,D,E,F,C,H,I,J,K,L]).
up([A,B,C,D,E,F,G,empty,I,J,K,L],[A,B,C,empty,E,F,G,D,I,J,K,L]).
up([A,B,C,D,E,F,G,H,empty,J,K,L],[A,B,C,D,empty,F,G,H,E,J,K,L]).
up([A,B,C,D,E,F,G,H,I,empty,K,L],[A,B,C,D,E,empty,G,H,I,F,K,L]).
up([A,B,C,D,E,F,G,H,I,J,empty,L],[A,B,C,D,E,F,empty,H,I,J,G,L]).
up([A,B,C,D,E,F,G,H,I,J,K,empty],[A,B,C,D,E,F,G,empty,I,J,K,H]).

/* use the current situation move four ways, get the next situation*/
move(Cur,Next,left) :- left(Cur,Next).
move(Cur,Next,up) :- up(Cur,Next).
move(Cur,Next,right) :- right(Cur,Next).
move(Cur,Next,down) :- down(Cur,Next).

/*insert into sort queue */
insert_sort_queue(State,[],[State]).
insert_sort_queue(State,[H|T],[State,H|T]) :- 
	precedes(State, H).
insert_sort_queue(State,[H|T],[H|T_new]) :- 
	insert_sort_queue(State,T,T_new).

/*remove element from list */
remove_sort_queue(H,[H|T],T).

/*sort function to implement a priority queue */
precedes([_,_,_,_,F1],[_,_,_,_,F2]) :- F1=<F2.

/*insert list to a sort queue */
insert_list([],L,L).
insert_list([H|T],L,New_L) :-
	insert_sort_queue(H,L,L2), insert_list(T,L2,New_L).

/*add to set */
add_to_set(X,S,S) :- member(X,S), !.
add_to_set(X,S,[X|S]).


/*record the state */
state_record(State, Parent, G, H, F, [State, Parent, G, H, F]).

/*
best first search function
Case 1 : Open is empty; no solution found
*/
best_first([],_,_) :-  
	write("graph searched, no solution found").
/*
Case 2 : The next record is a goal. 
print out the list of visited states.
*/
best_first(Open, Closed, Goal) :-
	remove_sort_queue(Next_record, Open, _ ),
	state_record(State, _, _, _, _, Next_record),
	State = Goal,
	write('Solution path is: '), nl,
	printSolution(Next_record, Closed).
/*
Case 3 : The next record is not the goal. 
Generate its children, add to open and continue. 
*/
best_first(Open, Closed, Goal) :-
	remove_sort_queue(Next_record, Open, Rest_of_open),
	findall(Child, moves(Next_record, Open, Closed, Child), Children),
	insert_list(Children, Rest_of_open, New_open),
	add_to_set(Next_record, Closed, New_closed),
	best_first(New_open, New_closed, Goal).


/*print out solution */
printSolution(Next_record,_) :-
	state_record(State, nil, _, _,_, Next_record),  write('List: '),write(State), nl.
printSolution(Next_record, Closed) :-
	state_record(State, Parent, G, _,_, Next_record),
	state_record(Parent, _, _, _, _, Parent_record),
	member(Parent_record, Closed),
	printSolution(Parent_record, Closed),
	write('step:'),write(G),write(State), nl.

/*generates one child of a state that is not already on open or closed.*/
moves(State_record, Open, Closed, Child) :-
	state_record(State,_,G,_,_,State_record),
	move(State,Next,Orient),
	state_record(Next,_,_,_,_,Test),
	not(member(Test,Open)),
	not(member(Test,Closed)),
	G_new is G + 1,
	heuristic(Next,H),
	F is G_new + H,
	state_record(Next, State, G_new, H, F, Child).


/* heuristic function*/
heuristic(List,H) :-
	%split list to three parts
	append(First,Second,Last,List),
	%count the number of same color, same position in the first row and the third row
	same_count(First, Last, H1),
	%check if there exists some position can be balanced moved by just one step
	adjacent_count(First,Second,Last,H2),
	%check id yellow is in the center
	yellow_in_center(Second,H3),
	H is H1 + H2 + H3.


/*split list to three parts*/
append([A,B,C,D],[E,F,G,H],[I,J,K,L],[A,B,C,D,E,F,G,H,I,J,K,L]).

/*count the number of the same color in the two lists*/
same_count([], [], 12).
same_count([H1|T1], [H2|T2], Count) :-
    same_count(T1, T2, TCount),
    (H1 = H2,!, Count is TCount - 3  ; Count is TCount).

/*check if there exists some position can be balanced moved by just one step*/
adjacent_count([empty,B,_,_],[E,_,_,_],[I,_,_,_],H):- (B \= I,E\=I,H=6,!;H=4).
adjacent_count([A,empty,C,_],[_,F,_,_],[_,J,_,_],H):- (A \= J,C\=J,F\=J,H=6,!;H=4).
adjacent_count([_,B,empty,D],[_,_,G,_],[_,_,K,_],H):- (B \= K,D \= K,G \= K,H=6,!;H=4).
adjacent_count([_,_,C,empty],[_,_,_,H],[_,_,_,L],H):- (C \= L,H\=L,H=6,!;H=4).
adjacent_count([A,_,_,_],[E,_,_,_],[empty,J,_,_],H):- (E \= A,J\=A,H=6,!;H=4).
adjacent_count([_,B,_,_],[_,F,_,_],[I,empty,K,_],H):- (I \= B,K\=B,F\=B,H=6,!;H=4).
adjacent_count([_,_,C,_],[_,_,G,_],[_,J,empty,L],H):- (J \= C,L\=C,G\=C,H=2,!;H=4).
adjacent_count([_,_,_,D],[_,_,_,H],[_,_,K,empty],H):- (K \= D,H\=D,H=2,!;H=4).
adjacent_count(L1,L2,L3,H):- member(empty,L2),H=5,!;H=7.

yellow_in_center(L,H):- member(yellow,L),H=5,!;H=7.

%create a random initial state
getRandomList([],[]).
getRandomList(SrcL,[HTarL|TTarL]) :-
	length(SrcL,Len),
	Index is random(Len),
	nth0(Index,SrcL,HTarL),
	select(HTarL,SrcL,RestL),
	getRandomList(RestL,TTarL).

%create a random initial state with empty
getRanColorBoard(RanColorBoard) :-
	getRandomList([red,red,red,red,blue,blue,blue,blue,white,white,yellow],RanL), !,
	append(RanL,[empty],RanColorBoard).


go(Start,Goal) :-
	Closed=[],
	heuristic(Start,H),
	state_record(Start,nil,0,H,H,First_record),
	insert_sort_queue(First_record, [ ], Open),
	best_first(Open, Closed, Goal).

play1 :- 
	statistics(real_time,_),
	getRanColorBoard(RanColorBoard),
	go(RanColorBoard,[A,B,C,D,_,_,_,_,A,B,C,D]), !,
	statistics(real_time,[_,TC]),
	write('Time elapsed:'), write(TC), nl.

play1(StartState) :- 
	statistics(real_time,_),
	go(StartState,[A,B,C,D,_,_,_,_,A,B,C,D]), !,
	statistics(real_time,[_,TC]),
	write('Time elapsed:'), write(TC), nl.

play7 :- 
	statistics(real_time,_),
	write('No.1'), nl,
	getRanColorBoard(RanColorBoard0),
	go(RanColorBoard0,[A0,B0,C0,D0,_,_,_,_,A0,B0,C0,D0]), !,
	write('No.2'), nl,
	getRanColorBoard(RanColorBoard1),
	go(RanColorBoard1,[A1,B1,C1,D1,_,_,_,_,A1,B1,C1,D1]), !,
	write('No.3'), nl,
	getRanColorBoard(RanColorBoard2),
	go(RanColorBoard2,[A2,B2,C2,D2,_,_,_,_,A2,B2,C2,D2]), !,
	write('No.4'), nl,
	getRanColorBoard(RanColorBoard3),
	go(RanColorBoard3,[A3,B3,C3,D3,_,_,_,_,A3,B3,C3,D3]), !,
	write('No.5'), nl,
	getRanColorBoard(RanColorBoard4),
	go(RanColorBoard4,[A4,B4,C4,D4,_,_,_,_,A4,B4,C4,D4]), !,
	write('No.6'), nl,
	getRanColorBoard(RanColorBoard5),
	go(RanColorBoard5,[A5,B5,C5,D5,_,_,_,_,A5,B5,C5,D5]), !,
	write('No.7'), nl,
	getRanColorBoard(RanColorBoard6),
	go(RanColorBoard6,[A6,B6,C6,D6,_,_,_,_,A6,B6,C6,D6]), !,
	statistics(real_time,[_,TC]),
	write('Time elapsed:'), write(TC), nl.

play7(StartStateList) :-
	statistics(real_time,_),
	write('No.1'), nl,
	nth0(0,StartStateList,ColorBoard0),
	go(ColorBoard0,[A0,B0,C0,D0,_,_,_,_,A0,B0,C0,D0]), !,
	write('No.2'), nl,
	nth0(1,StartStateList,ColorBoard1),
	go(ColorBoard1,[A1,B1,C1,D1,_,_,_,_,A1,B1,C1,D1]), !,
	write('No.3'), nl,
	nth0(2,StartStateList,ColorBoard2),
	go(ColorBoard2,[A2,B2,C2,D2,_,_,_,_,A2,B2,C2,D2]), !,
	write('No.4'), nl,
	nth0(3,StartStateList,ColorBoard3),
	go(ColorBoard3,[A3,B3,C3,D3,_,_,_,_,A3,B3,C3,D3]), !,
	write('No.5'), nl,
	nth0(4,StartStateList,ColorBoard4),
	go(ColorBoard4,[A4,B4,C4,D4,_,_,_,_,A4,B4,C4,D4]), !,
	write('No.6'), nl,
	nth0(5,StartStateList,ColorBoard5),
	go(ColorBoard5,[A5,B5,C5,D5,_,_,_,_,A5,B5,C5,D5]), !,
	write('No.7'), nl,
	nth0(6,StartStateList,ColorBoard6),
	go(ColorBoard6,[A6,B6,C6,D6,_,_,_,_,A6,B6,C6,D6]), !,
	statistics(real_time,[_,TC]),
	write('Time elapsed:'), write(TC), nl.


/* play1([yellow, blue, red, blue, red, white, white, blue, red, blue, red, empty]). */