fork download
copy 
  1. :- set_prolog_flag(verbose,silent).
  2. :- prompt(_, '').
  3. :- use_module(library(readutil)).
  4.  
  5. goal_check([[],_]).
  6. goal_check([[X,X,X,X],_]).
  7.  
  8. move_check([],_,_):-!,false.
  9. move_check([X,X,X,Y],[X,X,X],[Y]):-X\=Y.
  10. move_check([X,X,Y,Y2],[X,X],[Y,Y2]):-X\=Y.
  11. move_check([X,Y,Y2,Y3],[X],[Y,Y2,Y3]):-X\=Y.
  12. move_check([X,X,X],[X,X,X],[]).
  13. move_check([X,X,Y],[X,X],[Y]):-X\=Y.
  14. move_check([X,Y,Y2],[X],[Y,Y2]):-X\=Y.
  15. move_check([X,X],[X,X],[]).
  16. move_check([X,Y],[X],[Y]):-X\=Y.
  17. move_check([X],[X],[]).
  18.  
  19. move_ok(_,[]).
  20. move_ok([X|_],[X|_]).
  21.  
  22. head([Xs,_],Xs).
  23. get2([_,Xs],Xs).
  24.  
  25. swap([X,Y],[Y,X]).
  26.  
  27. cleaning_route(Data,[Next1,Now2]):-bagof(Now1,member([Next1,Now1],Data),Nows),[Now2|_]=Nows.
  28.  
  29. move(Xs1,Res):-select(X1,Xs1,Xs2),
  30. 				[E1,No1]=X1,
  31. 				move_check(E1,E1Move,E1Next),
  32. 				select(X2,Xs2,Xs),
  33. 				[E2,No2]=X2,
  34. 				move_ok(E1Move,E2),
  35. 				append(E1Move,E2,E2Next),
  36. 				length(E2Next,Len),
  37. 				Len<5,
  38. 				msort([[E1Next,No1],[E2Next,No2]|Xs],Res).
  39. search_all_move(Data1,[Next,Now1]):-member([Now1,_],Data1),move(Now1,Next).
  40.  
  41. my_equal(E1,E2):-maplist(head,E1,E1A),
  42. 				maplist(head,E2,E2A),
  43. 				sort([E1A,E2A],[E1A]).
  44.  
  45. my_more(E1,E2):-maplist(head,E1,E1A),
  46. 				maplist(head,E2,E2A),
  47. 				sort([E1A,E2A],[E1A,E2A]).
  48.  
  49. deduplication([],Data,Data):-!.
  50. deduplication(_,[],[]):-!.
  51. deduplication([Commit1|Data1],[[Next2,_]|Data2],Res):-my_equal(Commit1,Next2),!,deduplication([Commit1|Data1],Data2,Res).
  52. deduplication([Commit1|Data1],[[Next2,Now2]|Data2],Res):-my_more(Commit1,Next2),!,
  53. 								deduplication(Data1,[[Next2,Now2]|Data2],Res).
  54. deduplication([E1|Data1],[E2|Data2],[E2|Res]):-!,
  55. 								deduplication([E1|Data1],Data2,Res).
  56. format_ans(Data):-member([Now1,_],Data),
  57. 			maplist(swap,Now1,Now2),
  58. 			msort(Now2,Now3),
  59. 			maplist(get2,Now3,Now4),
  60. 			maplist(writeln,Now4),nl,false.
  61. format_ans(_).
  62. get_next(Data,Res):-member([Res,_],Data).
  63.  
  64. bfs(_,_,[],_):-!,read(_),halt.
  65. bfs(64,_,_,_):-!,read(_),halt.
  66. bfs(_,_,Data,[[Ans,Old1]]):-member([Ans,Old1],Data),maplist(goal_check,Ans),!.
  67. bfs(N,AllData1,Data1,[[NowRes,OldRes]|Res]):-N2 is N+1,
  68. 			setof(E1,search_all_move(Data1,E1),Data2),
  69. 			findall(E3,cleaning_route(Data2,E3),Data3),
  70. 			sort(Data3,Data4),
  71. 			deduplication(AllData1,Data4,Data5),
  72. 			findall(E5,get_next(Data5,E5),DataNext),
  73. 			append(AllData1,DataNext,AllData2),
  74. 			sort(AllData2,AllData3),
  75. 			length(AllData3,Len3),
  76. 			length(Data5,Len5),
  77. 			/*writeln([Len5,Len3,N]),*/
  78. 			!,
  79. 			bfs(N2,AllData3,Data5,Res),
  80. 			[[NextRes,NowRes]|_]=Res,
  81. 			member([NowRes,OldRes],Data1),
  82. 			!.
  83.  
  84. main:-
  85. 	process,halt.
  86.  
  87. process:-
  88. 	/*
  89. 	深さ4、ビーカー数可変のウォーターソートパズルを解くコード、答えの出力は手抜き状態、堀江 伸一
  90. 	テキストファイルに出力するコードに変えないとな。
  91. 	処理が重たくメモリも食うので、ビーカー数の少ない問題しか解けません。
  92. 	一応手元で問題を１問正しく解いたのは確認済みです。速度アップのための試行錯誤中
  93. 	*/
  94. 	msort([[[1,2,1,2],1],[[3,4,1,3],2],[[2,4,4,3],3],[[4,1,2,3],4],[[],5],[[],6]],Test2),
  95. 	bfs(0,[],[[Test2,[]]],Ans),
  96. 	format_ans(Ans),
  97. 	read(X),
  98. 	true.
  99. :-main.
Success #stdin #stdout #stderr 1.53s 73292KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
[1,2,1,2]
[3,4,1,3]
[2,4,4,3]
[4,1,2,3]
[]
[]

[2,1,2]
[3,4,1,3]
[2,4,4,3]
[4,1,2,3]
[1]
[]

[2,2,1,2]
[3,4,1,3]
[4,4,3]
[4,1,2,3]
[1]
[]

[2,2,1,2]
[3,4,1,3]
[4,4,4,3]
[1,2,3]
[1]
[]

[2,2,1,2]
[3,4,1,3]
[4,4,4,3]
[2,3]
[1,1]
[]

[1,2]
[3,4,1,3]
[4,4,4,3]
[2,2,2,3]
[1,1]
[]

[2]
[3,4,1,3]
[4,4,4,3]
[2,2,2,3]
[1,1,1]
[]

[2,2,2,2]
[3,4,1,3]
[4,4,4,3]
[3]
[1,1,1]
[]

[2,2,2,2]
[4,1,3]
[4,4,4,3]
[3,3]
[1,1,1]
[]

[2,2,2,2]
[1,3]
[4,4,4,3]
[3,3]
[1,1,1]
[4]

[2,2,2,2]
[3]
[4,4,4,3]
[3,3]
[1,1,1,1]
[4]

[2,2,2,2]
[]
[4,4,4,3]
[3,3,3]
[1,1,1,1]
[4]

[2,2,2,2]
[]
[3]
[3,3,3]
[1,1,1,1]
[4,4,4,4]

[2,2,2,2]
[]
[]
[3,3,3,3]
[1,1,1,1]
[4,4,4,4]
stderr
copy 
Warning: /home/pOwDoJ/prog:67:
	Singleton variables: [Len3,Len5,NextRes]
Warning: /home/pOwDoJ/prog:87:
	Singleton variables: [X]
https://ideone.com/2NOTLP
language:
Prolog (swi 7.6.4)
created:
1 day ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!