% Data: 3/05/2008
:- use_module(library(clpfd)).
:- dynamic todas_pecas/1.
init:- todas_pecas(L), assert(todas_pecas(L)), nl, write(L), length(L,X),nl,
write(‘Total of Pairs: ‘), write(X), nl, write(‘Pairs OK’).
some_pieces(N, Init_Piece ) :-
depth_search(N, [ Init_Piece ], Solution), %% initial piece
reverse(Solution,Inv_Sol), nl,
w_pieces(Inv_Sol), nl, write(‘Total of pieces :: ‘), write(N).
many_sets :- findall(Solution, depth_search(1, [ (7,8,9) ] , Solution), L),
length(L,X),
write(L),nl,
write(‘Total of sets :: ‘), write(X).
/*
Condição de Parada, um estado final… sem peças… ou sem casamentos…*/
depth_search(1 , Solution, Solution ) :- nl, write(‘FIM’), !.
/* observe que Solution da chamada anterior … é instanciada por casamento…
nada de atribuições… */
/* Núcleo do processo de busca…*/
depth_search( N , [(A,B,C) | L], Solution) :-
N > 1,
prox_pedra( (A,B,C), X_new ),
/* nova peças e testar se não é reincidente */
testar_pedra(X_new, [(A,B,C) | L]),
/* se esta peça não é menbro do jogo ainda… */
N1 is N – 1,
/* %% nl, write(N1), write(X_new),write((A,B,C)),nl,
%% write( [ X_new , (A,B,C ) | L]), */
depth_search( N1 , [ X_new , (A,B,C) | L], Solution).
depth_search( N , Solution,Solution ) :- nl, write(Solution), nl,
write(‘Total search: ‘), write(N), nl, write(‘FIM POR FALHA’), !.
min_pieces( Init_Piece ) :-
depth_min( [ Init_Piece ] , Solution), %% initial piece
%% nl,write(Solution),
length(Solution,X),
reverse(Solution,Inv_Sol), nl, %%% write(Inv_Sol),
valida(Inv_Sol),
w_pieces(Inv_Sol), nl, write(‘Total of pieces :: ‘), write(X),nl,
conta_A([1,2,3,4,5,6,7,8,9], Inv_Sol, Left),
conta_B([1,2,3,4,5,6,7,8,9], Inv_Sol, Right), nl,
write(‘Frequency of A terms in AxB :: ‘), write(Left),nl,
write(‘Frequency of B terms in AxB :: ‘), write(Right).
/*
Condição de Parada, um estado final… sem peças… ou sem casamentos…*/
depth_min( Solution, Solution ) :- length(Solution,X), X > 33,!.
/* observe que Solution da chamada anterior … é instanciada por casamento…
nada de atribuições… */
/* Núcleo do processo de busca…*/
depth_min( [(A,B,C) | L], Solution ) :-
/* gera peças */
prox_pedra( (A,B,C), X_new ),
/* nova peças e testar se não é reincidente */
testar_pedra( X_new, [(A,B,C) | L]),
/* se esta peça não é menbro do jogo ainda… */
depth_min([ X_new , (A,B,C) | L], Solution).
/* monta o conjunto com A */
all_A([],[]).
all_A( [A | L1 ], [(A,_,_)|L2]) :- all_A( L1, L2 ).
all_B([],[]).
all_B( [ B | L1 ], [(_,B,_)|L2]) :- all_B( L1, L2 ).
/* verifica se A e B são subconjuntos de [X|L] */
sub_set([],_,_).
sub_set([ X | L ], A, B) :- member(X,A), member(X,B), sub_set(L, A, B).
valida(Solution) :-
all_A( A, Solution),
all_B( B, Solution),
sub_set([1,2,3,4,5,6,7,8,9], A, B ), nl, write(‘PASSOU’), nl, !.
valida(Solution) :- nl, write(‘Precisa de mais de …’),
length(Solution,X), nl, write(X), write(‘ peças.’).
/* Simplesmente uma peça diferente */
prox_pedra( (A,B,C), X_new ) :-
todas_pecas( Todas ), !,
member( X_new, Todas ),
X_new \== (A,B,C).
prox_pedra( _ , _ ) :- nl, write(‘Some problem in new pieces’), !.
testar_pedra(_, []).
testar_pedra( (X,Y,Z) , [ (A,B,C) | L] ) :-
X * Y =:= C, %% 1a. condição
/* CUIDADO
+Expr1 =:= +Expr2 ===> IGUALDADE
True if expression Expr1 evaluates to a number equal to Expr2.
*/
A * B =\= Z, %% 2a. condição
/* +Expr1 =\= +Expr2
True if expression Expr1 evaluates to a number non-equal to Expr2.
*/
%% Z \== C, %% 3a. condição
/* Z não pode estar repetido … anteriormente na lista – fecha cilo */
not_member_tail( Z , L ),
/* um embaralhamento adicional … sem efeito */
( (ver_X_ou_Y( (X, Y ,_), L ),
Temp is X,
X is Y,
Y is Temp, !);
(true, !)).
%% testar_pedra(_, _ ) :- nl, write(‘Some problem in Testing pieces’), !.
/* verificar se X ou Y já ocorreram na lista … apenas uma vez ai troca-se */
ver_X_ou_Y( (X,_,_), [(X,_,_) | _]) :- !.
ver_X_ou_Y( (_, Y ,_), [(_, Y,_) | _]) :- !.
ver_X_ou_Y( (X, Y ,_), [(A, B,_) | L ]) :-
(X \== A ; Y \== B) ,
ver_X_ou_Y( (X, Y ,_), L ).
/* uma vez eh diferente da anterior…*/
ver_X_e_Y( _ , []) :- !.
ver_X_e_Y( (X, Y ,_), [(A, B,_) | L ]) :-
(X \== A ; Y \== B) ,
ver_X_ou_Y( (X, Y ,_), L ).
not_member_tail( _, [] ):- !.
not_member_tail( Z , [(A ,B , C) | L] ) :-
Z =\= A*B, %% se Z não ocorreu anteriormente …no prefixo
Z \== C, %% nem no sufixo
not_member_tail( Z, L).
todas_pecas( All_Pairs ) :-
dom_1_81(D), pares_2(P),
combina3(P,D, All_Pairs ).
/*, nl, write(R),
write(D), nl, write(P), nl,
length(R, X), nl, write(X).
*/
/* 1. tem que eliminar o não multiplos
2. eliminar os duplicados tipo [m,n,k] deixar [n,m,k]
*/
%% gera pecas modo 2
gera_pecas_2(L3) :- findall( P, teste2(P), L ), nl, dom_1_81(D),
remove_fora_dom(L, L2, D ),
remove_d_3(L2, L3 ),
length(L3, X3),
write(L3), nl,
write(‘Total de Pares: ‘), write(X3).
teste2([X,Y,C]) :-
[X,Y] ins 1 .. 9,
C in 1 .. 81,
X*Y #\= C,
label([X,Y,C]).
%%% test_2 :- teste2([X,Y,C]), label([X,Y,C]), write([X,Y,C]).
/*
6480
2835
1575
MUITO MAIS LENTO….
*/
gera_par([X,Y]) :-
Var = [X,Y],
Var ins 1 .. 9, %%% ins … plural
label(Var).
pares_2(L2) :- findall( X, gera_par(X), L1),
/* length(L1,X1), write(X1), nl, */
remove_d_2(L1,L2).
/* , length(L2,X2), write(X2), nl, write(L2). */
/* the results from the products of numbers 1 up to 9 x 1 .. 9 */
dom_1_81(Domain) :-
Var = [1,2,3,4,5,6,7,8,9],
gera_dom_mult(Var, Temp1 ),
rem_double(Temp1,Temp2),
sort(Temp2,Domain).
gera_dom_mult([], []) :- !.
gera_dom_mult([ X ], [ Z | L1 ]) :-
Z is X*X,
L2 = [1,2,3,4,5,6,7,8,9],
delete_up_to(L2, X, L3),
gera_dom_mult(L3 , L1 ).
/* the first multiplies by the rest – each two */
gera_dom_mult([ N1, N2 | L1 ],[ Z | L2 ]) :-
Z is N1*N2,
gera_dom_mult([N1|L1], L2).
/* delete all element in ordered list up to a given X */
delete_up_to([], _, []) :- !.
delete_up_to([X|L], X, L).
delete_up_to([_|L], X, L2) :- delete_up_to(L, X, L2).
/*****************************************************************************************************/
/* duplicated are removed */
rem_double([],[]).
rem_double([A|L1], [A|L2]) :- \+ member( A , L1), rem_double( L1 , L2 ).
rem_double([_|L1], L2) :- rem_double( L1 , L2 ).
/* [[x,y], …[]] X [1,2 ... 81] –> [(x,y,1), ....(n,m,81)]
1575 pecas possiveis! …*/
combina3(ListaPares,Elementos,Resp) :- mapeia(Elementos,ListaPares,ListaPares,Resp).
mapeia([],_,_,[]) :-!.
mapeia( [_ | As ],M,[],Ac) :-
mapeia(As,M,M,Ac).
mapeia([A|As],M,[[C1,C2]|Bs],[(C1,C2,A)|Ac]) :-
A =\= C1*C2,
mapeia([A|As],M,Bs,Ac).
/*
+Expr1 =\= +Expr2 [ISO]
True if expression Expr1 evaluates to a number non-equal to Expr2.
*/
mapeia([A|As],M,[_|Bs], Ac) :-
mapeia([A|As], M , Bs, Ac).
/* remove os duplicados na lista [1,1] até [9,9], onde [2,9] é igual a [9,2] */
remove_d_2([],[]).
remove_d_2([[A,B]|L1], [[A,B]|L2]) :- A == B, remove_d_2( L1 , L2 ). %%manter [1,1] .. [9,9]
%% vai removendo os pares que aparecem logo no início .. [2,9] é removido e fica [9,2]
remove_d_2([[A,B]|L1], [[A,B]|L2]) :- A \== B, \+ member( [B,A] , L1), remove_d_2( L1 , L2 ).
remove_d_2([[_,_]|L1], L2) :- remove_d_2(L1 , L2 ).
/* remove os duplicados quase igual ao anterior */
remove_d_3([],[]).
remove_d_3([[A,B,C]|L1], [[A,B,C]|L2]) :- \+ member( [B,A,C] , L1), remove_d_3( L1 , L2 ).
remove_d_3([[_,_,_]|L1], L2) :- remove_d_3( L1 , L2 ).
remove_fora_dom([],[], _).
remove_fora_dom([[A,B,C]|L1], [[A,B,C]|L2],D) :- member(C,D), remove_fora_dom( L1 , L2 , D).
remove_fora_dom([[_,_,_]|L1], L2, D) :- remove_fora_dom( L1 , L2 , D).
/****************************************************************************************************/
% Contando as saidas em A X B:
/**** right side: A ****/
conta_A([],_,[]) :- !.
conta_A([A|L1], L2, [A/N | L3]) :-
conta_aux_A(A, L2, N),
remove_A(A, L2, L4),
conta_A(L1, L4, L3).
conta_aux_A(_,[],0) :- !.
conta_aux_A(A,[(A,_,_)|L], N) :- conta_aux_A(A,L,N1), N is N1 + 1.
conta_aux_A(A,[(X,_,_)|L], N) :- A \==X, conta_aux_A( A , L, N).
remove_A(_, [],[]) :- !.
remove_A(A,[(A,_,_)| L1], L2) :- remove_A(A, L1, L2).
remove_A(A,[(X,Y,Z)| L1], [(X,Y,Z) | L2]) :- remove_A(A, L1, L2).
/**** right side: B ****/
conta_B([],_,[]) :- !.
conta_B([B|L1], L2, [ B/N | L3 ]) :-
conta_aux_B(B, L2, N),
remove_B(B, L2, L4),
conta_B(L1, L4, L3).
conta_aux_B(_,[],0) :- !.
conta_aux_B(B,[(_ , B ,_)|L], N) :- conta_aux_B(B,L,N1), N is N1 + 1.
conta_aux_B(B,[(_, X ,_)|L], N) :- B \==X, conta_aux_B( B , L, N).
remove_B(_, [],[]) :- !.
remove_B(B,[(_,B,_)| L1], L2):- remove_B(B, L1, L2).
remove_B(B,[(X,Y,Z)| L1], [(X,Y,Z) | L2]) :- remove_B(B, L1, L2).
/*****************************************************************************************************/
w_pieces([]).
w_pieces([(A,B,C)]):- write(A),write(‘x’),write(B),write(‘:’), write(C),write(‘ || ‘).
w_pieces([(A,B,C),(D,E,F) | L ]):- write(A),write(‘x’),write(B),write(‘:’), write(C),write(‘ || ‘),
write(D),write(‘x’),write(E),write(‘:’), write(F),write(‘ || ‘),
w_pieces(L).
/*****************************************************************************************************/
