fork download
copy 
  1. :- set_prolog_flag(verbose,silent).
  2. :- prompt(_, '').
  3. :- use_module(library(readutil)).
  4.  
  5. goal_check([]):-!.
  6. goal_check([[[],_]|Xs]):-goal_check(Xs).
  7. goal_check([[[X,X,X,X],_]|Xs]):-goal_check(Xs).
  8.  
  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. format_ans(Data):-member([_,E1],Data),maplist(swap,E1,E2),msort(E2,E3),
  26. 					maplist(get2,E3,E4),maplist(writeln,E4),nl,false.
  27. format_ans(_).
  28.  
  29. my_equal(E1,E2):-maplist(head,E1,E1A),
  30. 				maplist(head,E2,E1A).
  31.  
  32. my_equal_or_more(E1,E2):-maplist(head,E1,E1A),
  33. 				maplist(head,E2,E2A),
  34. 				msort([E1A,E2A],[E1A,E2A]).
  35.  
  36. move(Xs1,Res):-select(X1,Xs1,Xs2),
  37. 				[E1,No1]=X1,
  38. 				move_check(E1,E1Move,E1Next),
  39. 				select(X2,Xs2,Xs),
  40. 				[E2,No2]=X2,
  41. 				move_ok(E1Move,E2),
  42. 				append(E1Move,E2,E2Next),
  43. 				length(E2Next,Len),
  44. 				Len<5,
  45. 				msort([[E1Next,No1],[E2Next,No2]|Xs],Res).
  46.  
  47. search_all_move(Data1,[Now1,Next]):-member([_,Now1],Data1),move(Now1,Next).
  48.  
  49. swap([Old1,Now1],[Now1,Old1]).
  50. all_swap(Data,Res):-member(E1,Data),swap(E1,Res).
  51.  
  52. deduplication([],Data,Data):-!.
  53. deduplication(_,[],[]):-!.
  54. deduplication([[Old1,_]|Data1],[[_,Next1]|Data2],Res):-my_equal(Old1,Next1),!,deduplication(Data1,Data2,Res).
  55. deduplication([[Old1,_]|Data1],[[Now2,Next2]|Data2],Res):-my_equal_or_more(Old1,Next2),!,
  56. 								deduplication(Data1,[[Now2,Next2]|Data2],Res).
  57. deduplication([E1|Data1],[E2|Data2],[E2|Res]):-!,
  58. 								deduplication([E1|Data1],Data2,Res).
  59.  
  60. bfs(Data,[[Old1,Ans2]]):-member([Old1|Ans],Data),maplist(goal_check,Ans),!,[Ans2]=Ans.
  61. bfs(Data1,[[Old1,Now1]|Res1]):-
  62. 				setof(E1,search_all_move(Data1,E1),Data2),
  63. 				sort(Data2,Data3),
  64. 				maplist(swap,Data1,Data1Swap),
  65. 				sort(Data1Swap,Data1Swap2),
  66. 				deduplication(Data1Swap2,Data3,Data4),
  67. 				deduplication(Data1,Data4,Data5),
  68. 				sort(Data5,Data6),
  69. 				bfs(Data6,Res1),
  70. 				[[Now1,_]|_]=Res1,
  71. 				member([Old1,Now1],Data1),
  72. 				!.
  73. main:-
  74. 	process,
  75. 	halt.
  76.  
  77. process:-
  78. 	/*
  79. 	ウォーターソートパズルを解くコード、答えの出力は手抜き状態、堀江 伸一
  80. 	ただいまビーカーを並べ替えてない答えを出すための記述方法を思考中
  81. 	バグがあったのでそれの修整を検討中
  82. 	取り合えず完成かな？
  83. 	バグが残ってないか作問して確かめたいな。
  84. 	他人の作問をテストデータに使うのはこのサイトではできないな。
  85. 	*/
  86. 	msort([[[1,2,2,2],1],[[2,1,1,1],2],[[],3],[[],4]],Test),
  87. 	bfs([[[],Test]],Ans),
  88. 	format_ans(Ans),
  89. 	true.
  90.  
  91. :- main.
Success #stdin #stdout 0.05s 7168KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
[1,2,2,2]
[2,1,1,1]
[]
[]

[2,2,2]
[2,1,1,1]
[]
[1]

[2,2,2,2]
[1,1,1]
[]
[1]

[2,2,2,2]
[]
[]
[1,1,1,1]
https://ideone.com/5ZTrHM
language:
Prolog (swi 7.6.4)
created:
5 days 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!