Skip to content

Instantly share code, notes, and snippets.

@aarroyoc

aarroyoc/game.pl

Created May 16, 2022 15:54
Show Gist options
  • Save aarroyoc/ba415d2a091effaa7b39eae3f45c4885 to your computer and use it in GitHub Desktop.
Save aarroyoc/ba415d2a091effaa7b39eae3f45c4885 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
game.pl
:- use_module(library(lists)).
:- use_module(library(random)).
:- use_module(library(tabling)).
:- table move/2.
run(N) :-
generate_random(N, State),
solve(State, History),
maplist(display_state, History).
display_state([L1, L2, L3, L4]) :-
format("---------------\n", []),
format("|~a|~a|~a|~a|~a|~a|~a|~n", L1),
format("---------------\n", []),
format("|~a|~a|~a|~a|~a|~a|~a|~n", L2),
format("---------------\n", []),
format("|~a|~a|~a|~a|~a|~a|~a|~n", L3),
format("---------------\n", []),
format("|~a|~a|~a|~a|~a|~a|~a|~n", L4),
format("---------------\n", []).
generate_random(0, State) :-
end_state(State).
generate_random(N, State) :-
N \= 0,
N1 is N - 1,
generate_random(N1, S1),
findall(S, move(S1, S), NextStates),
random_member(State, NextStates).
end_state([
['@', 'A', 'B', 'C', 'D', 'E', 'F'],
['G', 'H', 'I', 'J', 'K', 'L', 'M'],
['N', 'O', 'P', 'Q', 'R', 'S', 'T'],
['U', 'V', 'W', 'X', 'Y', 'Z', ' ']]).
order_count(S0, N) :-
end_state(S),
flatten(S, FS),
flatten(S0, FS0),
order_count(FS, FS0, N).
order_count([], [], 0).
order_count([X|Xs], [Y|Ys], N) :-
X \= Y,
order_count(Xs, Ys, N0),
N is N0 + 1.
order_count([X|Xs],[X|Ys], N) :-
order_count(Xs, Ys, N0),
N = N0.
manhattan_count(S0, N) :-
end_state(S),
flatten(S0, FS0),
flatten(S, FS),
manhattan_count(FS0, FS0, FS, N).
manhattan_count([], _, _, 0).
manhattan_count([X|Xs], S0, S, N) :-
nth0(Pos0, S0, X),
nth0(Pos, S, X),
Pos0X is Pos0 mod 7,
Pos0Y is Pos0 // 7,
PosX is Pos mod 7,
PosY is Pos // 7,
manhattan_count(Xs, S0, S, N0),
N is N0 + abs(PosX - Pos0X) + abs(PosY - Pos0Y).
h_count(D, S, N-S) :-
order_count(S, N0),
manhattan_count(S, N1),
N is N1 + N0 + D.
depth_ancestors(Depth, A, N-S, N-S-D-A) :-
D is Depth + 1.
solve(State, History) :-
end_state(EndState),
solve([0-State-0-[]], EndState, [], H),
reverse(History, H).
solve([_-X-_-H|_], X, _, H).
solve([_-X-Depth-Ancestors|Xs], S, Visited, H) :-
findall(State, move(X, State), States),!,
maplist(h_count(Depth), States, StatesAndScores),
maplist(depth_ancestors(Depth, [_|Ancestors]), StatesAndScores, NewStates),
append(Xs, NewStates, AllOpenStates),
subtract(AllOpenStates, Visited, OpenStates),
keysort(OpenStates, OrderedOpenStates),
!,
solve(OrderedOpenStates, S, [_-X-_-_|Visited], H).
% left
move(S0, S1) :-
maplist(swap_left, S0, S1),
S0 \= S1.
% right
move(S0, S1) :-
maplist(swap_right, S0, S1),
S0 \= S1.
% up
move([L1, L2, L3, L4], [NL1, NL2, L3, L4]) :-
nth0(N, L2, ' '),
swap(N, L1, L2, NL1, NL2).
move([L1, L2, L3, L4], [L1, NL2, NL3, L4]) :-
nth0(N, L3, ' '),
swap(N, L2, L3, NL2, NL3).
move([L1, L2, L3, L4], [L1, L2, NL3, NL4]) :-
nth0(N, L4, ' '),
swap(N, L3, L4, NL3, NL4).
% down
move([L1, L2, L3, L4], [NL1, NL2, L3, L4]) :-
nth0(N, L1, ' '),
swap(N, L1, L2, NL1, NL2).
move([L1, L2, L3, L4], [L1, NL2, NL3, L4]) :-
nth0(N, L2, ' '),
swap(N, L2, L3, NL2, NL3).
move([L1, L2, L3, L4], [L1, L2, NL3, NL4]) :-
nth0(N, L3, ' '),
swap(N, L3, L4, NL3, NL4).
swap_left([X], [X]).
swap_left([X,Y|Xs], [X|Ys]) :-
Y \= ' ',
swap_left([Y|Xs], Ys).
swap_left([X,' '|Xs], [' ',X|Xs]).
swap_right([X], [X]).
swap_right([X,Y|Xs], [X|Ys]) :-
X \= ' ',
swap_right([Y|Xs], Ys).
swap_right([' ',X|Xs], [X,' '|Xs]).
swap(N, L1, L2, NL1, NL2) :-
swap_(N, L1, L2, NL1, NL2).
swap_(0, [X|Xs], [Y|Ys], [Y|Xs], [X|Ys]).
swap_(N, [X|Xs], [Y|Ys], [X|Ws], [Y|Zs]) :-
N1 is N - 1,
swap_(N1, Xs, Ys, Ws, Zs).
Raw
gistfile1.txt
:- use_module(library(lists)).
:- use_module(library(random)).
:- use_module(library(tabling)).
:- table move/2.
run(N, History) :-
generate_random(N, State),
solve(State, History).
display_state([L1, L2, L3, L4]) :-
format("---------------\n", []),
format("|~a|~a|~a|~a|~a|~a|~a|~n", L1),
format("---------------\n", []),
format("|~a|~a|~a|~a|~a|~a|~a|~n", L2),
format("---------------\n", []),
format("|~a|~a|~a|~a|~a|~a|~a|~n", L3),
format("---------------\n", []),
format("|~a|~a|~a|~a|~a|~a|~a|~n", L4),
format("---------------\n", []).
generate_random(0, State) :-
end_state(State).
generate_random(N, State) :-
N \= 0,
N1 is N - 1,
generate_random(N1, S1),
findall(S, move(S1, S), NextStates),
random_member(State, NextStates).
end_state([
['@', 'A', 'B', 'C', 'D', 'E', 'F'],
['G', 'H', 'I', 'J', 'K', 'L', 'M'],
['N', 'O', 'P', 'Q', 'R', 'S', 'T'],
['U', 'V', 'W', 'X', 'Y', 'Z', ' ']]).
order_count(S0, N) :-
end_state(S),
flatten(S, FS),
flatten(S0, FS0),
order_count(FS, FS0, N).
order_count([], [], 0).
order_count([X|Xs], [Y|Ys], N) :-
X \= Y,
order_count(Xs, Ys, N0),
N is N0 + 1.
order_count([X|Xs],[X|Ys], N) :-
order_count(Xs, Ys, N0),
N = N0.
manhattan_count(S0, N) :-
end_state(S),
flatten(S0, FS0),
flatten(S, FS),
manhattan_count(FS0, FS0, FS, N).
manhattan_count([], _, _, 0).
manhattan_count([X|Xs], S0, S, N) :-
nth0(Pos0, S0, X),
nth0(Pos, S, X),
Pos0X is Pos0 mod 7,
Pos0Y is Pos0 // 7,
PosX is Pos mod 7,
PosY is Pos // 7,
manhattan_count(Xs, S0, S, N0),
N is N0 + abs(PosX - Pos0X) + abs(PosY - Pos0Y).
h_count(S, N) :-
order_count(S, N0),
manhattan_count(S, N1),
N is N1 + N0*3.
solve(State, History) :-
end_state(EndState),
solve(State, EndState, [State], History).
solve(S0, S, H, H) :-
move(S0, S).
solve(S0, S, H, FinalH) :-
findall(State, move(S0, State), States),
subtract(States, H, RStates),
maplist(h_count, RStates, Scores),
min_list(Scores, Min),
findall(State, (member(State, RStates), h_count(State, Min)), MinStates),
member(S1, MinStates),
format("H-Count: ~d\n", [Min]),
display_state(S1),
solve(S1, S, [S1|H], FinalH).
% left
move(S0, S1) :-
maplist(swap_left, S0, S1),
S0 \= S1.
% right
move(S0, S1) :-
maplist(swap_right, S0, S1),
S0 \= S1.
% up
move([L1, L2, L3, L4], [NL1, NL2, L3, L4]) :-
nth0(N, L2, ' '),
swap(N, L1, L2, NL1, NL2).
move([L1, L2, L3, L4], [L1, NL2, NL3, L4]) :-
nth0(N, L3, ' '),
swap(N, L2, L3, NL2, NL3).
move([L1, L2, L3, L4], [L1, L2, NL3, NL4]) :-
nth0(N, L4, ' '),
swap(N, L3, L4, NL3, NL4).
% down
move([L1, L2, L3, L4], [NL1, NL2, L3, L4]) :-
nth0(N, L1, ' '),
swap(N, L1, L2, NL1, NL2).
move([L1, L2, L3, L4], [L1, NL2, NL3, L4]) :-
nth0(N, L2, ' '),
swap(N, L2, L3, NL2, NL3).
move([L1, L2, L3, L4], [L1, L2, NL3, NL4]) :-
nth0(N, L3, ' '),
swap(N, L3, L4, NL3, NL4).
swap_left([X], [X]).
swap_left([X,Y|Xs], [X|Ys]) :-
Y \= ' ',
swap_left([Y|Xs], Ys).
swap_left([X,' '|Xs], [' ',X|Xs]).
swap_right([X], [X]).
swap_right([X,Y|Xs], [X|Ys]) :-
X \= ' ',
swap_right([Y|Xs], Ys).
swap_right([' ',X|Xs], [X,' '|Xs]).
swap(N, L1, L2, NL1, NL2) :-
swap_(N, L1, L2, NL1, NL2).
swap_(0, [X|Xs], [Y|Ys], [Y|Xs], [X|Ys]).
swap_(N, [X|Xs], [Y|Ys], [X|Ws], [Y|Zs]) :-
N1 is N - 1,
swap_(N1, Xs, Ys, Ws, Zs).
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment