How to solve 15-puzzle paradigm in Prolog with Manhattan & Hamming Heuristics - search
I have this implementation of the 15-puzzle game, using Prolog (Swipl). I have already implemented the A* search using Manhattan heuristic, but now I need to add hamming heuristic.
Do yo know how to implement it?
:- op(400,yfx,'#').
resolver(Estado,MovimientosSolucion) :- evaluar(Estado,0,F),
buscarSolucion([Estado#0#F#[]],S), reverse(S,MovimientosSolucion).
evaluar(Estado,Profundidad,F) :- evaluarCoste(Estado,Coste),
F is Profundidad + Coste.
buscarSolucion([Estado#_#_#MovimientosSolucion|_], MovimientosSolucion) :- solucion(Estado).
buscarSolucion([B|R],S) :- expandir(B,Sucesores),
insertarTodos(Sucesores,R,ListaAbiertos),
buscarSolucion(ListaAbiertos,S).
insertarUno(B,ListaAbiertos,ListaAbiertos) :- nodoRepetido(B,ListaAbiertos), ! .
insertarUno(B,[C|R],[B,C|R]) :- costeMenor(B,C), ! .
insertarUno(B,[B1|R],[B1|S]) :- insertarUno(B,R,S), !.
insertarUno(B,[],[B]).
insertarTodos([F|R],ListaAbiertos1,ListaAbiertos2) :- insertarUno(F,ListaAbiertos1,ListaAbiertos3),
insertarTodos(R,ListaAbiertos3,ListaAbiertos2).
insertarTodos([],ListaAbiertos,ListaAbiertos).
nodoRepetido(Estado#_#_#_, [Estado#_#_#_|_]).
costeMenor( _#_#F1#_ , _#_#F2#_ ) :- F1 < F2.
expandir(Estado#Profundidad#_#S,Sucesores) :- findall(Sucesor#Profundidad1#F#[Movimiento|S],
(Profundidad1 is Profundidad+1,
mover(Estado,Sucesor,Movimiento),
evaluar(Sucesor,Profundidad1,F)), Sucesores).
solucion(1/2/3/4/5/6/7/8/9/10/11/12/13/14/15/0).
manhattan(A/B/C/D/E/F/G/H/I/J/K/L/M/N/O/P, Coste) :- a(A,CosteA), b(B,CosteB), c(C,CosteC), d(D, CosteD),
e(E,CosteE), f(F,CosteF), g(G,CosteG), h(H,CosteH),
i(I,CosteI), j(J,CosteJ), k(K,CosteK), l(L,CosteL),
m(M,CosteM), n(N,CosteN), o(O,CosteO), p(P,CosteP),
Coste is CosteA + CosteB + CosteC + CosteD + CosteE + CosteF + CosteG + CosteH + CosteI + CosteJ + CosteK + CosteL + CosteM + CosteN + CosteO + CosteP.
evaluarCoste(Tablero,Coste) :- hamming_distance(Tablero,Coste).
mover(TableroInicial,TableroFinal,moverArriba) :- moverArriba(TableroInicial,TableroFinal).
mover(TableroInicial,TableroFinal,moverAbajo) :- moverAbajo(TableroInicial,TableroFinal).
mover(TableroInicial,TableroFinal,moverDerecha) :- moverDerecha(TableroInicial,TableroFinal).
mover(TableroInicial,TableroFinal,moverIzquierda) :- moverIzquierda(TableroInicial,TableroFinal).
moverArriba(A/B/C/D/0/F/G/H/I/J/K/L/M/N/O/P,0/B/C/D/A/F/G/H/I/J/K/L/M/N/O/P).
moverArriba(A/B/C/D/E/0/G/H/I/J/K/L/M/N/O/P,A/0/C/D/E/B/G/H/I/J/K/L/M/N/O/P).
moverArriba(A/B/C/D/E/F/0/H/I/J/K/L/M/N/O/P,A/B/0/D/E/F/C/H/I/J/K/L/M/N/O/P).
moverArriba(A/B/C/D/E/F/G/0/I/J/K/L/M/N/O/P,A/B/C/0/E/F/G/D/I/J/K/L/M/N/O/P).
moverArriba(A/B/C/D/E/F/G/H/0/J/K/L/M/N/O/P,A/B/C/D/0/F/G/H/E/J/K/L/M/N/O/P).
moverArriba(A/B/C/D/E/F/G/H/I/0/K/L/M/N/O/P,A/B/C/D/E/0/G/H/I/F/K/L/M/N/O/P).
moverArriba(A/B/C/D/E/F/G/H/I/J/0/L/M/N/O/P,A/B/C/D/E/F/0/H/I/J/G/L/M/N/O/P).
moverArriba(A/B/C/D/E/F/G/H/I/J/K/0/M/N/O/P,A/B/C/D/E/F/G/0/I/J/K/H/M/N/O/P).
moverArriba(A/B/C/D/E/F/G/H/I/J/K/L/0/N/O/P,A/B/C/D/E/F/G/H/0/J/K/L/I/N/O/P).
moverArriba(A/B/C/D/E/F/G/H/I/J/K/L/M/0/O/P,A/B/C/D/E/F/G/H/I/0/K/L/M/J/O/P).
moverArriba(A/B/C/D/E/F/G/H/I/J/K/L/M/N/0/P,A/B/C/D/E/F/G/H/I/J/0/L/M/N/K/P).
moverArriba(A/B/C/D/E/F/G/H/I/J/K/L/M/N/O/0,A/B/C/D/E/F/G/H/I/J/K/0/M/N/O/L).
moverAbajo(0/B/C/D/E/F/G/H/I/J/K/L/M/N/O/P,E/B/C/D/0/F/G/H/I/J/K/L/M/N/O/P).
moverAbajo(A/0/C/D/E/F/G/H/I/J/K/L/M/N/O/P,A/F/C/D/E/0/G/H/I/J/K/L/M/N/O/P).
moverAbajo(A/B/0/D/E/F/G/H/I/J/K/L/M/N/O/P,A/B/G/D/E/F/0/H/I/J/K/L/M/N/O/P).
moverAbajo(A/B/C/0/E/F/G/H/I/J/K/L/M/N/O/P,A/B/C/H/E/F/G/0/I/J/K/L/M/N/O/P).
moverAbajo(A/B/C/D/0/F/G/H/I/J/K/L/M/N/O/P,A/B/C/D/I/F/G/H/0/J/K/L/M/N/O/P).
moverAbajo(A/B/C/D/E/0/G/H/I/J/K/L/M/N/O/P,A/B/C/D/E/J/G/H/I/0/K/L/M/N/O/P).
moverAbajo(A/B/C/D/E/F/0/H/I/J/K/L/M/N/O/P,A/B/C/D/E/F/K/H/I/J/0/L/M/N/O/P).
moverAbajo(A/B/C/D/E/F/G/0/I/J/K/L/M/N/O/P,A/B/C/D/E/F/G/L/I/J/K/0/M/N/O/P).
moverAbajo(A/B/C/D/E/F/G/H/0/J/K/L/M/N/O/P,A/B/C/D/E/F/G/H/M/J/K/L/0/N/O/P).
moverAbajo(A/B/C/D/E/F/G/H/I/0/K/L/M/N/O/P,A/B/C/D/E/F/G/H/I/N/K/L/M/0/O/P).
moverAbajo(A/B/C/D/E/F/G/H/I/J/0/L/M/N/O/P,A/B/C/D/E/F/G/H/I/J/O/L/M/N/0/P).
moverAbajo(A/B/C/D/E/F/G/H/I/J/K/0/M/N/O/P,A/B/C/D/E/F/G/H/I/J/K/P/M/N/O/0).
moverDerecha(0/B/C/D/E/F/G/H/I/J/K/L/M/N/O/P,B/0/C/D/E/F/G/H/I/J/K/L/M/N/O/P).
moverDerecha(A/0/C/D/E/F/G/H/I/J/K/L/M/N/O/P,A/C/0/D/E/F/G/H/I/J/K/L/M/N/O/P).
moverDerecha(A/B/0/D/E/F/G/H/I/J/K/L/M/N/O/P,A/B/D/0/E/F/G/H/I/J/K/L/M/N/O/P).
moverDerecha(A/B/C/D/0/F/G/H/I/J/K/L/M/N/O/P,A/B/C/D/F/0/G/H/I/J/K/L/M/N/O/P).
moverDerecha(A/B/C/D/E/0/G/H/I/J/K/L/M/N/O/P,A/B/C/D/E/G/0/H/I/J/K/L/M/N/O/P).
moverDerecha(A/B/C/D/E/F/0/H/I/J/K/L/M/N/O/P,A/B/C/D/E/F/H/0/I/J/K/L/M/N/O/P).
moverDerecha(A/B/C/D/E/F/G/H/0/J/K/L/M/N/O/P,A/B/C/D/E/F/G/H/J/0/K/L/M/N/O/P).
moverDerecha(A/B/C/D/E/F/G/H/I/0/K/L/M/N/O/P,A/B/C/D/E/F/G/H/I/K/0/L/M/N/O/P).
moverDerecha(A/B/C/D/E/F/G/H/I/J/0/L/M/N/O/P,A/B/C/D/E/F/G/H/I/J/L/0/M/N/O/P).
moverDerecha(A/B/C/D/E/F/G/H/I/J/K/L/0/N/O/P,A/B/C/D/E/F/G/H/I/J/K/L/N/0/O/P).
moverDerecha(A/B/C/D/E/F/G/H/I/J/K/L/M/0/O/P,A/B/C/D/E/F/G/H/I/J/K/L/M/O/0/P).
moverDerecha(A/B/C/D/E/F/G/H/I/J/K/L/M/N/0/P,A/B/C/D/E/F/G/H/I/J/K/L/M/N/P/0).
moverIzquierda(A/0/C/D/E/F/G/H/I/J/K/L/M/N/O/P,0/A/C/D/E/F/G/H/I/J/K/L/M/N/O/P).
moverIzquierda(A/B/0/D/E/F/G/H/I/J/K/L/M/N/O/P,A/0/B/D/E/F/G/H/I/J/K/L/M/N/O/P).
moverIzquierda(A/B/C/0/E/F/G/H/I/J/K/L/M/N/O/P,A/B/0/C/E/F/G/H/I/J/K/L/M/N/O/P).
moverIzquierda(A/B/C/D/E/0/G/H/I/J/K/L/M/N/O/P,A/B/C/D/0/E/G/H/I/J/K/L/M/N/O/P).
moverIzquierda(A/B/C/D/E/F/0/H/I/J/K/L/M/N/O/P,A/B/C/D/E/0/F/H/I/J/K/L/M/N/O/P).
moverIzquierda(A/B/C/D/E/F/G/0/I/J/K/L/M/N/O/P,A/B/C/D/E/F/0/G/I/J/K/L/M/N/O/P).
moverIzquierda(A/B/C/D/E/F/G/H/I/0/K/L/M/N/O/P,A/B/C/D/E/F/G/H/0/I/K/L/M/N/O/P).
moverIzquierda(A/B/C/D/E/F/G/H/I/J/0/L/M/N/O/P,A/B/C/D/E/F/G/H/I/0/J/L/M/N/O/P).
moverIzquierda(A/B/C/D/E/F/G/H/I/J/K/0/M/N/O/P,A/B/C/D/E/F/G/H/I/J/0/K/M/N/O/P).
moverIzquierda(A/B/C/D/E/F/G/H/I/J/K/L/M/0/O/P,A/B/C/D/E/F/G/H/I/J/K/L/0/M/O/P).
moverIzquierda(A/B/C/D/E/F/G/H/I/J/K/L/M/N/0/P,A/B/C/D/E/F/G/H/I/J/K/L/M/0/N/P).
% coste en distancias de cada posicion
a(0,6). a(1,0). a(2,1). a(3,2). a(4,3). a(5,1). a(6,2). a(7,3). a(8,4). a(9,2). a(10,3). a(11,4). a(12,5). a(13,3). a(14,4). a(15,5).
b(0,5). b(1,1). b(2,0). b(3,1). b(4,2). b(5,2). b(6,1). b(7,2). b(8,3). b(9,3). b(10,2). b(11,3). b(12,4). b(13,4). b(14,3). b(15,4).
c(0,4). c(1,2). c(2,1). c(3,0). c(4,1). c(5,3). c(6,2). c(7,1). c(8,2). c(9,4). c(10,3). c(11,2). c(12,3). c(13,5). c(14,4). c(15,3).
d(0,3). d(1,3). d(2,2). d(3,1). d(4,0). d(5,4). d(6,3). d(7,2). d(8,1). d(9,5). d(10,4). d(11,3). d(12,2). d(13,6). d(14,5). d(15,4).
e(0,5). e(1,1). e(2,2). e(3,3). e(4,4). e(5,0). e(6,1). e(7,2). e(8,3). e(9,1). e(10,2). e(11,3). e(12,4). e(13,2). e(14,3). e(15,4).
f(0,4). f(1,2). f(2,1). f(3,2). f(4,3). f(5,1). f(6,0). f(7,1). f(8,2). f(9,2). f(10,1). f(11,2). f(12,3). f(13,3). f(14,2). f(15,3).
g(0,3). g(1,3). g(2,2). g(3,1). g(4,2). g(5,2). g(6,1). g(7,0). g(8,1). g(9,3). g(10,2). g(11,1). g(12,2). g(13,4). g(14,3). g(15,2).
h(0,2). h(1,4). h(2,3). h(3,2). h(4,1). h(5,3). h(6,2). h(7,1). h(8,0). h(9,4). h(10,3). h(11,2). h(12,1). h(13,5). h(14,4). h(15,3).
i(0,4). i(1,2). i(2,3). i(3,4). i(4,5). i(5,1). i(6,2). i(7,3). i(8,4). i(9,0). i(10,1). i(11,2). i(12,3). i(13,1). i(14,2). i(15,3).
j(0,3). j(1,3). j(2,2). j(3,3). j(4,4). j(5,2). j(6,1). j(7,2). j(8,3). j(9,1). j(10,0). j(11,1). j(12,2). j(13,2). j(14,1). j(15,2).
k(0,2). k(1,4). k(2,3). k(3,2). k(4,3). k(5,3). k(6,2). k(7,1). k(8,2). k(9,2). k(10,1). k(11,0). k(12,1). k(13,3). k(14,2). k(15,1).
l(0,1). l(1,5). l(2,4). l(3,3). l(4,2). l(5,4). l(6,3). l(7,2). l(8,1). l(9,3). l(10,2). l(11,1). l(12,0). l(13,4). l(14,3). l(15,2).
m(0,3). m(1,3). m(2,4). m(3,5). m(4,6). m(5,2). m(6,3). m(7,4). m(8,5). m(9,1). m(10,2). m(11,3). m(12,4). m(13,0). m(14,1). m(15,2).
n(0,2). n(1,4). n(2,3). n(3,4). n(4,5). n(5,3). n(6,2). n(7,3). n(8,4). n(9,2). n(10,1). n(11,2). n(12,3). n(13,1). n(14,0). n(15,1).
o(0,1). o(1,5). o(2,4). o(3,3). o(4,4). o(5,4). o(6,3). o(7,2). o(8,3). o(9,3). o(10,2). o(11,1). o(12,2). o(13,2). o(14,1). o(15,0).
p(0,0). p(1,6). p(2,5). p(3,4). p(4,3). p(5,5). p(6,4). p(7,3). p(8,2). p(9,4). p(10,3). p(11,2). p(12,1). p(13,3). p(14,2). p(15,1).
Thanks a lot
Here is the solver for 8-puzzle, extended... maybe it will use too much memory. It implements simply a greedy heuristic. Could be interesting to extend it with A*...
/* File: fifteen_puzzle.pl
Author: Carlo,,,
Created: Jul 9 2014
Purpose: solve 15-puzzle
*/
:- module(fifteen_puzzle,
[fifteen_puzzle/3
]).
:- use_module(library(nb_set)).
:- use_module(library(plunit)).
%% fifteen_puzzle(+Target, +Start, -Moves) is nondet.
%
% public interface to solver
%
fifteen_puzzle(Target, Start, Moves) :-
empty_nb_set(E),
solve(E, Target, Start, Moves).
%% -- private here --
solve(_, Target, Target, []) :-
!.
solve(S, Target, Current, [Move|Ms]) :-
add_to_seen(S, Current),
setof(Dist-M-Update,
( get_move(Current, P, M),
apply_move(Current, P, M, Update),
distance(Target, Update, Dist)
), Moves),
member(_-Move-U, Moves),
solve(S, Target, U, Ms).
%% get_move(+Board, +P, -Q) is semidet
%
% based only on coords, get next empty cell
%
get_move(Board, P, Q) :-
nth0(P, Board, 0),
coord(P, R, C),
( R < 3, Q is P + 4
; R > 0, Q is P - 4
; C < 3, Q is P + 1
; C > 0, Q is P - 1
).
%% apply_move(+Current, +P, +M, -Update)
%
% swap elements at position P and M
%
apply_move(Current, P, M, Update) :-
assertion(nth0(P, Current, 0)), % constrain to this application usage
( P > M -> (F,S) = (M,P) ; (F,S) = (P,M) ),
nth0(S, Current, Sv, A),
nth0(F, A, Fv, B),
nth0(F, C, Sv, B),
nth0(S, Update, Fv, C).
%% coord(+P, -R, -C)
%
% from linear index to row, col
% size fixed to 4*4
%
coord(P, R, C) :-
R is P // 4,
C is P mod 4.
%% distance(+Current, +Target, -Dist)
%
% compute Manatthan distance between equals values
%
distance(Current, Target, Dist) :-
aggregate_all(sum(D),
( nth0(P, Current, N), coord(P, Rp, Cp),
nth0(Q, Target, N), coord(Q, Rq, Cq),
D is abs(Rp - Rq) + abs(Cp - Cq)
), Dist).
%% add_to_seen(+S, +Current)
%
% fail if already in, else store
%
add_to_seen(S, L) :-
%term_to_atom(L, A),
findall(C, (nth0(I, L, D), C is D*10^I), Cs),
sum_list(Cs, A),
add_nb_set(A, S, true).
:- begin_tests(fifteen_puzzle).
show_square(R) :-
findall(Row, (between(1,4,_), length(Row, 4)), Rows),
append(Rows, R),
nl, maplist(show_row, Rows).
show_row(R) :-
format('~t~d~3+~t~d~3+~t~d~3+~t~d~3+~n', R).
show_solution(P, []) :-
show_square(P).
show_solution(P, [M|Ms]) :-
show_square(P),
nth0(C, P, 0),
apply_move(P, C, M, U),
show_solution(U, Ms).
target( [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,0]).
start(0, [1,2,3,4,5,6,7,8,9,10,11,12,0,13,14,15]).
start(1, [1,2,3,4,5,6,7,8,0,10,11,12,9,13,14,15]).
test(0) :- runtest(0).
test(1) :- runtest(1).
runtest(N) :-
target(T),
start(N, S),
fifteen_puzzle(T, S, R),
format('solution of ~d: ~w~n', [N, R]),
show_solution(S, R).
:- end_tests(fifteen_puzzle).
you can use ?- run_tests(fifteen_puzzle). for a simple test.
Related
Why does my Lua SHA-256 algorithm here give a different output than examples?
function sha256.encrypt(s)
--initialize hash values
local h0 = 0x6a09e667
local h1 = 0xbb67ae85
local h2 = 0x3c6ef372
local h3 = 0xa54ff53a
local h4 = 0x510e527f
local h5 = 0x9b05688c
local h6 = 0x1f83d9ab
local h7 = 0x5be0cd19
--initialize round constants
local k = {0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5,
0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3, 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174,
0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc, 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da,
0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7, 0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967,
0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13, 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85,
0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3, 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070,
0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5, 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3,
0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208, 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2}
--preprocess string
local message = preprocessMessage(s)
--main compression
for i = 1, #message / 512 do
local w = createMessageSchedule(string.sub(message, 512 * (i - 1) + 1, 512 * (i - 1) + 512))
--initialize working values
local a = h0
local b = h1
local c = h2
local d = h3
local e = h4
local f = h5
local g = h6
local h = h7
for i = 1, 64 do
local S1 = bit.bxor(bit.bxor(xbit.brrotate(e, 6), xbit.brrotate(e, 11)), xbit.brrotate(e, 25))
local ch = bit.bxor(bit.band(e, f), bit.band(bit.bnot(e), g))
local temp1 = h + S1 + ch + k[i] + w[i]
local S0 = bit.bxor(bit.bxor(xbit.brrotate(a, 2), xbit.brrotate(a, 13)), xbit.brrotate(a, 22))
local maj = bit.bxor(bit.bxor(bit.band(a, b), bit.band(a, c)), bit.band(b, c))
local temp2 = S0 + maj
h = g
g = f
f = e
e = d + temp1
d = c
c = b
b = a
a = temp1 + temp2
h0 = (h0 + a) % 2^32
h1 = (h1 + b) % 2^32
h2 = (h2 + c) % 2^32
h3 = (h3 + d) % 2^32
h4 = (h4 + e) % 2^32
h5 = (h5 + f) % 2^32
h6 = (h6 + g) % 2^32
h7 = (h7 + h) % 2^32
end
end
return string.format('%08x%08x%08x%08x%08x%08x%08x%08x', h0, h1, h2, h3, h4, h5, h6, h7)
end
I am here trying to create my own implementation of SHA-256 for ComputerCraft. Yes, I know this is a pointless endeavor and I could just grab a prewritten library written by a more skilled programmer for this purpose, but there's no fun in doing that. I've gotten it to a state where it yields deterministic (same input = same output every time), fairly unpredictable (you can't easily tell what it will output based on the input), 64-byte-wide string outputs, but the output is still different from examples, telling me I did something wrong somewhere along the way.
tips: band = bitwise and, bor = bitwise or, bxor = bitwise xor (these are ccraft library functions)
I just need a fresh pair of eyes because I am sick of looking at this trying to figure out what went wrong. I've already verified that the function definitions I haven't included (preprocessMessage, createMessageSchedule) are working as intended.
Actual output for ''
d877d0451a38a0ef791326d2bfd61ab65b2348741f88c19b757670864c457e2f
Expected output for ''
e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855
Actual output for 'hello world'
7c892f56e8ad9c894d37007889c7964d346f54875bfe1faf9c33e0f8870f9010
Expected output for 'hello world'
b94d27b9934d3e08a52e52d7da7dabfac484efe37a5380ee9088f7ace2efcde9
Problem with spec block in literate haskell file
I have this block of code on my literate haskell file
\end{code}
\paragraph{Valorização}
Codigo em C
\begin{spec}
double co(double x, int n){
double a = 1;
double b = -1 * x * x / 2;
double c = 12;
double d = 18;
for(; n > 0; n--){
a = a + b;
b = b * (-1 * x * x) / c;
c = c + d;
d = 8 + d;
}
return a;
}
\end{spec}
\subsection*{Problema 4}
What's happening is, when using lhs2tex and the pdflatex, what's inside the spec block is being completely ignored, and everything after it is forward, like it has a tab before it... Maybe this is something common? I'm not used to this... First time using it
By the way, if I remove the spec block everything else is formatted correctly
The following answer is based on speculation. If you would provide an MCVE—a short .lhs file that clearly demonstrates the issue—perhaps a better answer could emerge.
I think the issue is that lhs2TeX is not meant for C code. It gets confused by the spec block, thinks that it is Haskell code, and outputs problematic TeX commands. In fact, I can't even get your posted code past pdflatex—the .tex is that broken. You can use a different mechanism to output C code. The minted package should do.
\documentclass{article}
%include lhs2TeX.fmt
\usepackage{minted}
\setlength{\parindent}{0pt}
\begin{document}
Some C code:
\begin{minted}{c}
double co(double x, int n){
double a = 1;
double b = -1 * x * x / 2;
double c = 12;
double d = 18;
for(; n > 0; n--){
a = a + b;
b = b * (-1 * x * x) / c;
c = c + d;
d = 8 + d;
}
return a;
}
\end{minted}
It can be directly translated into Haskell:
\begin{code}
co :: Double -> Int -> Double
co x = worker 1 (-1 * x * x / 2) 12 18
where worker a _ _ _ 0 = a
worker a b c d n = worker (a + b) (b * (-1 * x * x) / c) (c + d) (8 + d) (n - 1)
\end{code}
As you can see, \textit{Haskell} code passes through just fine.
\end{document}
PS: The weird for-loop can be written while(n-- > 0) { ... }, no?
Detect all k-length words of string in prolog
Words are any symbol characters that are separated by white-spaces or by start/end points of string. For ex. [w,o,r,d,1,' ',w,o,r,d,2]. I need to find all k-length words of given string and append them into the result string (separated with white-spaces). This is what I'm expecting for example in the case of k = 5: ?- kthWords([w,o,r,d,1,'',w,r,d,'',w,o,r,d,2], 5, X). X = [w,o,r,d,1,'',w,o,r,d,2].
You could write: final_kthWords(L,K,Outlist):- kthWords(L,K,L1), reverse(L1,[_|T]), reverse(T,Outlist). kthWords([],_,[]):-!. kthWords(L,K,L1):- find_word(L,Word,L2), length(Word,N), (N=:=K-> append(Word,[' '|T],L1),kthWords(L2,K,T); kthWords(L2,K,L1)). find_word([],[],[]). find_word([H|T],[H|T1],L):-dif(H,' '),find_word(T,T1,L). find_word([H|T],[],T):- H = ' '. Where kthWords/3 calls find_word/2 which finds the words and finally kthWords returns the output list but it adds an ' ' in the end. The only thing that final_kthWords(L,K,Outlist)/3 does is removing the extra ' ' in the end of the list and returns the right list: ?- final_kthWords([w,o,r,d,1,' ',w,r,d,' ',w,o,r,d,2], 5, X). X = [w, o, r, d, 1, ' ', w, o, r, d, 2] ; false.
Hoping that someone else can propose a simpler solution... the following seems to work kthWordsH([], 0, _, R0, R0). kthWordsH([], N, _, _, []) :- N \= 0. kthWordsH([' ' | Tl], 0, Len, W, Revult) :- kthWordsH(Tl, Len, Len, [], Res0), append(Res0, [' ' | W], Revult). kthWordsH([' ' | Tl], N, Len, _, Revult) :- N \= 0, kthWordsH(Tl, Len, Len, [], Revult). kthWordsH([H | Tl], 0, Len, _, Revult) :- H \= ' ', kthWordsH(Tl, Len, Len, [], Revult). kthWordsH([H | Tl], N, Len, Tw, Revult) :- H \= ' ', N \= 0, Nm1 is N-1, kthWordsH(Tl, Nm1, Len, [H | Tw], Revult). kthWords(List, Len, Result) :- kthWordsH(List, Len, Len, [], Revult), reverse(Revult, Result).
Solution without reverse. % return a word of k length, or return [] otherwise kword(K,L,W):- length(L,K) -> append(L,[' '],W); W=[]. % if no more chars, then check final word in L and % append to word list Ls to return Lw kwords(K,[],L,Ls,Lw):- kword(K,L,W), append(Ls,W,Lw). % if char is space, then append to Ls if word of length K % if not space, append char to "in progress" work list L kwords(K,[C|Cs],L,Ls,Lw):- ( C=' ' -> ( kword(K,L,W), append(Ls,W,Ls0), L2 = [] ); ( append(L,[C],L2), Ls0 = Ls ) ), kwords(K,Cs,L2,Ls0,Lw). % intialise predicate call with empty word and empty result kthWords(Cs,K,L):- kwords(K,Cs,[],[],L).
How to Find a Point Where a Circle and Line with 1/0 Slope Intersect
I'm writing a simple 2D top-down game in Python 3 using tkinter. All the collidable objects are either circles/arcs or lines. I wrote the following method to detect when a circle hits a line: I am using the formulas y = mx + b and r^2 = (x-h)^2 + (y-k)^2 def CheckHitCToL(self, LX0, LY0, LX1, LY1, CX0, CX1, Tab): try: H = self.Creatures[Tab].X K = self.Creatures[Tab].Y R = abs((CX0 - CX1) / 2) M = (LY0 - LY1) / (LX0 - LX1) B = M * (-LX1) + LY1 QA = (M * M) + 1 QB = (-H - H) + (((B - K) * M) * 2) QC = (H * H) + ((B - K) * (B - K)) - (R * R) X = (- QB + sqrt((QB * QB) - (4 * QA * QC))) / (2 * QA) Y = (M * X) + B if ((X <= LX0 and X >= LX1) or (X >= LX0 and X <= LX1)) and ((Y <= LY0 and Y >= LY1) or (Y >= LY0 and Y <= LY1)): return True else: return False except: return False My problem is when you have a vertical line, M (Or the slope) is (LY0 - LY1) / 0. (This is because the slope is equal to rise/run, and vertical lines don't have a run, just a rise) Which of course returns an error, caught by try except, which then informs my movement method that no collision has taken place. Of course I can simply move the "try:" down a few lines, but it's still going to throw an error. How can I adapt this program to not throw an error when working with a vertical line?
Well, the most obvious method would involve using if( (LX0 - LX1)==0 ) and doing this case separately. In such cases, you need to check whether distance between LX0 and CX0 is equal to the radius of circle.
You can use another forms of line equation - implicit A*x + B*y + C = 0 or parametric x = LX0 + t * (LX1 - LX0), y = LY0 + t *(LY1 - LY0) with appropriate modification of calculations
How to find "nearest" value in a large list in Erlang
Suppose I have a large collection of integers (say 50,000,000 of them). I would like to write a function that returns me the largest integer in the collection that doesn't exceed a value passed as a parameter to the function. E.g. if the values were: Values = [ 10, 20, 30, 40, 50, 60] then find(Values, 25) should return 20. The function will be called many times a second and the collection is large. Assuming that the performance of a brute-force search is too slow, what would be an efficient way to do it? The integers would rarely change, so they can be stored in a data structure that would give the fastest access. I've looked at gb_trees but I don't think you can obtain the "insertion point" and then get the previous entry. I realise I could do this from scratch by building my own tree structure, or binary chopping a sorted array, but is there some built-in way to do it that I've overlooked?
To find nearest value in large unsorted list I'd suggest you to use divide and conquer strategy - and process different parts of list in parallel. But enough small parts of list may be processed sequentially.
Here is code for you:
-module( finder ).
-export( [ nearest/2 ] ).
-define( THRESHOLD, 1000 ).
%%
%% sequential finding of nearest value
%%
%% if nearest value doesn't exists - return null
%%
nearest( Val, List ) when length(List) =< ?THRESHOLD ->
lists:foldl(
fun
( X, null ) when X < Val ->
X;
( _X, null ) ->
null;
( X, Nearest ) when X < Val, X > Nearest ->
X;
( _X, Nearest ) ->
Nearest
end,
null,
List );
%%
%% split large lists and process each part in parallel
%%
nearest( Val, List ) ->
{ Left, Right } = lists:split( length(List) div 2, List ),
Ref1 = spawn_nearest( Val, Left ),
Ref2 = spawn_nearest( Val, Right ),
Nearest1 = receive_nearest( Ref1 ),
Nearest2 = receive_nearest( Ref2 ),
%%
%% compare nearest values from each part
%%
case { Nearest1, Nearest2 } of
{ null, null } ->
null;
{ null, Nearest2 } ->
Nearest2;
{ Nearest1, null } ->
Nearest1;
{ Nearest1, Nearest2 } when Nearest2 > Nearest1 ->
Nearest2;
{ Nearest1, Nearest2 } when Nearest2 =< Nearest1 ->
Nearest1
end.
spawn_nearest( Val, List ) ->
Ref = make_ref(),
SelfPid = self(),
spawn(
fun() ->
SelfPid ! { Ref, nearest( Val, List ) }
end ),
Ref.
receive_nearest( Ref ) ->
receive
{ Ref, Nearest } -> Nearest
end.
Testing in shell:
1> c(finder).
{ok,finder}
2>
2> List = [ random:uniform(1000) || _X <- lists:seq(1,100000) ].
[444,724,946,502,312,598,916,667,478,597,143,210,698,160,
559,215,458,422,6,563,476,401,310,59,579,990,331,184,203|...]
3>
3> finder:nearest( 500, List ).
499
4>
4> finder:nearest( -100, lists:seq(1,100000) ).
null
5>
5> finder:nearest( 40000, lists:seq(1,100000) ).
39999
6>
6> finder:nearest( 4000000, lists:seq(1,100000) ).
100000
Performance: (single node)
7>
7> timer:tc( finder, nearest, [ 40000, lists:seq(1,10000) ] ).
{3434,10000}
8>
8> timer:tc( finder, nearest, [ 40000, lists:seq(1,100000) ] ).
{21736,39999}
9>
9> timer:tc( finder, nearest, [ 40000, lists:seq(1,1000000) ] ).
{314399,39999}
Versus plain iterating:
1>
1> timer:tc( lists, foldl, [ fun(_X, Acc) -> Acc end, null, lists:seq(1,10000) ] ).
{14994,null}
2>
2> timer:tc( lists, foldl, [ fun(_X, Acc) -> Acc end, null, lists:seq(1,100000) ] ).
{141951,null}
3>
3> timer:tc( lists, foldl, [ fun(_X, Acc) -> Acc end, null, lists:seq(1,1000000) ] ).
{1374426,null}
So, yo may see, that on list with 1000000 elements, function finder:nearest is faster than plain iterating through list with lists:foldl.
You may find optimal value of THRESHOLD in your case.
Also you may improve performance, if spawn processes on different nodes.
Here is another code sample that uses ets. I believe a lookup would be made in about constant time:
1> ets:new(tab,[named_table, ordered_set, public]).
2> lists:foreach(fun(N) -> ets:insert(tab,{N,[]}) end, lists:seq(1,50000000)).
3> timer:tc(fun() -> ets:prev(tab, 500000) end).
{21,499999}
4> timer:tc(fun() -> ets:prev(tab, 41230000) end).
{26,41229999}
The code surrounding would be a bit more than this of course but it is rather neat
So if the input isn't sorted, you can get a linear version by doing: closest(Target, [Hd | Tl ]) -> closest(Target, Tl, Hd). closest(_Target, [], Best) -> Best; closest(Target, [ Target | _ ], _) -> Target; closest(Target, [ N | Rest ], Best) -> CurEps = erlang:abs(Target - Best), NewEps = erlang:abs(Target - N), if NewEps < CurEps -> closest(Target, Rest, N); true -> closest(Target, Rest, Best) end. You should be able to do better if the input is sorted. I invented my own metric for 'closest' here as I allow the closest value to be higher than the target value - you could change it to be 'closest but not greater than' if you liked.
In my opinion, if you have a huge collection of data that does not change often, you shoud think about organize it.
I have wrote a simple one based on ordered list, including insertion an deletion functions. It gives good results for both inserting and searching.
-module(finder).
-export([test/1,find/2,insert/2,remove/2,new/0]).
-compile(export_all).
new() -> [].
insert(V,L) ->
{R,P} = locate(V,L,undefined,-1),
insert(V,R,P,L).
find(V,L) ->
locate(V,L,undefined,-1).
remove(V,L) ->
{R,P} = locate(V,L,undefined,-1),
remove(V,R,P,L).
test(Max) ->
{A,B,C} = erlang:now(),
random:seed(A,B,C),
L = lists:seq(0,100*Max,100),
S = random:uniform(100000000),
I = random:uniform(100000000),
io:format("start insert at ~p~n",[erlang:now()]),
L1 = insert(I,L),
io:format("start find at ~p~n",[erlang:now()]),
R = find(S,L1),
io:format("end at ~p~n result is ~p~n",[erlang:now(),R]).
remove(_,_,-1,L) -> L;
remove(V,V,P,L) ->
{L1,[V|L2]} = lists:split(P,L),
L1 ++ L2;
remove(_,_,_,L) ->L.
insert(V,V,_,L) -> L;
insert(V,_,-1,L) -> [V|L];
insert(V,_,P,L) ->
{L1,L2} = lists:split(P+1,L),
L1 ++ [V] ++ L2.
locate(_,[],R,P) -> {R,P};
locate (V,L,R,P) ->
%% io:format("locate, value = ~p, liste = ~p, current result = ~p, current pos = ~p~n",[V,L,R,P]),
{L1,[M|L2]} = lists:split(Le1 = (length(L) div 2), L),
locate(V,R,P,Le1+1,L1,M,L2).
locate(V,_,P,Le,_,V,_) -> {V,P+Le};
locate(V,_,P,Le,_,M,L2) when V > M -> locate(V,L2,M,P+Le);
locate(V,R,P,_,L1,_,_) -> locate(V,L1,R,P).
which give the following results
(exec#WXFRB1824L)6> finder:test(10000000).
start insert at {1347,28177,618000}
start find at {1347,28178,322000}
end at {1347,28178,728000}
result is {72983500,729836}
that is 704ms to insert a new value in a list of 10 000 000 elements and 406ms to find the nearest value int the same list.
I tried to have a more accurate information about the performance of the algorithm I proposed above, an reading the very interesting solution of Stemm, I decide to use the tc:timer/3 function. Big deception :o). On my laptop, I got a very bad accuracy of the time. So I decided to left my corei5 (2 cores * 2 threads) + 2Gb DDR3 + windows XP 32bit to use my home PC: Phantom (6 cores) + 8Gb + Linux 64bit.
Now tc:timer works as expected, I am able to manipulate lists of 100 000 000 integers. I was able to see that I was loosing a lot of time calling at each step the length function, so I re-factored the code a little to avoid it:
-module(finder).
-export([test/2,find/2,insert/2,remove/2,new/0]).
%% interface
new() -> {0,[]}.
insert(V,{S,L}) ->
{R,P} = locate(V,L,S,undefined,-1),
insert(V,R,P,L,S).
find(V,{S,L}) ->
locate(V,L,S,undefined,-1).
remove(V,{S,L}) ->
{R,P} = locate(V,L,S,undefined,-1),
remove(V,R,P,L,S).
remove(_,_,-1,L,S) -> {S,L};
remove(V,V,P,L,S) ->
{L1,[V|L2]} = lists:split(P,L),
{S-1,L1 ++ L2};
remove(_,_,_,L,S) ->{S,L}.
%% local
insert(V,V,_,L,S) -> {S,L};
insert(V,_,-1,L,S) -> {S+1,[V|L]};
insert(V,_,P,L,S) ->
{L1,L2} = lists:split(P+1,L),
{S+1,L1 ++ [V] ++ L2}.
locate(_,[],_,R,P) -> {R,P};
locate (V,L,S,R,P) ->
S1 = S div 2,
S2 = S - S1 -1,
{L1,[M|L2]} = lists:split(S1, L),
locate(V,R,P,S1+1,L1,S1,M,L2,S2).
locate(V,_,P,Le,_,_,V,_,_) -> {V,P+Le};
locate(V,_,P,Le,_,_,M,L2,S2) when V > M -> locate(V,L2,S2,M,P+Le);
locate(V,R,P,_,L1,S1,_,_,_) -> locate(V,L1,S1,R,P).
%% test
test(Max,Iter) ->
{A,B,C} = erlang:now(),
random:seed(A,B,C),
L = {Max+1,lists:seq(0,100*Max,100)},
Ins = test_insert(L,Iter,[]),
io:format("insert:~n~s~n",[stat(Ins,Iter)]),
Fin = test_find(L,Iter,[]),
io:format("find:~n ~s~n",[stat(Fin,Iter)]).
test_insert(_L,0,Res) -> Res;
test_insert(L,I,Res) ->
V = random:uniform(1000000000),
{T,_} = timer:tc(finder,insert,[V,L]),
test_insert(L,I-1,[T|Res]).
test_find(_L,0,Res) -> Res;
test_find(L,I,Res) ->
V = random:uniform(1000000000),
{T,_} = timer:tc(finder,find,[V,L]),
test_find(L,I-1,[T|Res]).
stat(L,N) ->
Aver = lists:sum(L)/N,
{Min,Max,Var} = lists:foldl(fun (X,{Mi,Ma,Va}) -> {min(X,Mi),max(X,Ma),Va+(X-Aver)*(X-Aver)} end, {999999999999999999999999999,0,0}, L),
Sig = math:sqrt(Var/N),
io_lib:format(" average: ~p,~n minimum: ~p,~n maximum: ~p,~n sigma : ~p.~n",[Aver,Min,Max,Sig]).
Here are some results.
1> finder:test(1000,10).
insert:
average: 266.7,
minimum: 216,
maximum: 324,
sigma : 36.98121144581393.
find:
average: 136.1,
minimum: 105,
maximum: 162,
sigma : 15.378231367748375.
ok
2> finder:test(100000,10).
insert:
average: 10096.5,
minimum: 9541,
maximum: 12222,
sigma : 762.5642595873478.
find:
average: 5077.4,
minimum: 4666,
maximum: 6937,
sigma : 627.126494417195.
ok
3> finder:test(1000000,10).
insert:
average: 109871.1,
minimum: 94747,
maximum: 139916,
sigma : 13852.211285206417.
find:
average: 40428.0,
minimum: 31297,
maximum: 56965,
sigma : 7797.425562325042.
ok
4> finder:test(100000000,10).
insert:
average: 8067547.8,
minimum: 6265625,
maximum: 16590349,
sigma : 3199868.809140206.
find:
average: 8484876.4,
minimum: 5158504,
maximum: 15950944,
sigma : 4044848.707872872.
ok
On the 100 000 000 list, it is slow, and the multi process solution cannot help on this dichotomy algorithm... It is a weak point of this solution, but if you have several processes in parallel requesting to find a nearest value, it will be able to use the multicore anyway.
Pascal.