SWISH -- SWI-Prolog for SHaring

% this is prolog
%
% By Leandro Santiago (leandro@setefaces.org) on 2022-09-24
%
% In the query view, type:
% run.
% 
% And click in the `Run!` button.
%
% This program solves the interesting "Dog Bunny Puzzle", by Conrad Barski.
% http://www.dogbunnypuzzle.com/
% 
% I had not written or read any Prolog for 5 years, so it was interesting to work
% on this exercise!
%
% I am still a newbie in Prolog, so there's plenty of room for improvement in this program!
%
% I've tested it on SWI-Prolog 8.4.3.

place(bone).
place(house).
place(boat).
place(tree).
place(carrot).
place(well).
place(flower).

path(bone, house, [somebody(carrot)]).
path(house, bone, [somebody(carrot)]).
path(bone, boat, []).
path(house, tree, [somebody(bone), somebody(flower)]).
path(tree, house, [somebody(bone), somebody(flower)]).
path(house, boat, [somebody(tree)]).
path(boat, house, [somebody(tree)]).
path(flower, boat, []).
path(flower, well, []).
path(well, flower, []).
path(tree, well, []).
path(well, tree, []).
path(well, carrot, [nobody(bone)]).
path(carrot, well, [nobody(bone)]).
path(carrot, tree, []).

% This is our main.
run :-
  run([house, boat, tree], [carrot, carrot, bone], Result),
  describe_actions(1, Result), !.

% From here on, only implementation details

describe_actions(_, []).
describe_actions(C, [H | T]) :-
  print_action(C, H), nl,
  NewC is C + 1,
  describe_actions(NewC, T).

% TODO: this for sure can be refactored
print_action(C, [[O, _, _], [D, _, _]]) :- dif(O, D), format('~d bunny1 moves to from ~w to ~w', [C, O, D]), !.
print_action(C, [[_, O, _], [_, D, _]]) :- dif(O, D), format('~d bunny2 moves to from ~w to ~w', [C, O, D]), !.
print_action(C, [[_, _, O], [_, _, D]]) :- dif(O, D), format('~d dog    moves to from ~w to ~w', [C, O, D]), !.

transitions(States, Transitions) :-
  findall([Bunny1Place, Bunny2Place, DogPlace], (place(Bunny1Place), place(Bunny2Place), place(DogPlace)), States),
  % note: we invert the edges of the graph (dest -> orig), as we perform a BFS from the final state,
  % so it's easier to invert it here
  findall(D - O, (member(O, States), member(D, States), valid_path(O, D)), Transitions).

equals_len(C, [], [], C).
equals_len(C, [P | TO], [P | TD], R) :-
  NewC is C + 1,
  equals_len(NewC, TO, TD, R).

equals_len(C, [O | TO], [D | TD], R) :-
  dif(O, D),
  equals_len(C, TO, TD, R).

valid_path(O, D) :-
  equals_len(0, O, D, 2), % only one change is allowed per transition, thus 3 - 1 = 2
  path_exists(O, D, C),
  constraints_valid(C, O).

path_exists([O | _], [D | _], C) :- path(O, D, C), !.
path_exists([_| OT], [_| DT], C) :- path_exists(OT, DT, C).

constraints_valid([], _).
constraints_valid([C | T], Origin) :-
  single_constraint_valid(C, Origin),
  constraints_valid(T, Origin).

single_constraint_valid(somebody(P), Origin) :- member(P, Origin).
single_constraint_valid(nobody(P), Origin) :- \+ member(P, Origin).

run(Initial, Final, Result) :-
  transitions(_, T),
  vertices_edges_to_ugraph([], T, G),
  search_shortest_path(G, Initial, Final, Result).

% heavily based on http://www.cs.nott.ac.uk/~pszbsl/G52APT/slides/10-Breadth-first-search.pdf
search_shortest_path(G, Initial, Final, Result) :-
  search_shortest_path_util(G, Initial, [n(Final, [])], [], Result).

search_shortest_path_util(_, Initial, [n(Initial, P) | _], _, P).
search_shortest_path_util(G, Initial, [n(S, P1) | Ns], C, P) :-
  length(P1, L),
  neighbors(S, G, Neighbors),
  findall(
    n(S1, [[S1, S]|P1]),
    (member(S1, Neighbors), \+ member(n(S1, P2), Ns), length(P2, L), \+ ord_memberchk(S1, C)),
    Es),
  append(Ns, Es, O),
  ord_add_element(C, S, NewC),
  search_shortest_path_util(G, Initial, O, NewC, P).