hi everibody, i have to wright a prolog program to find such a perfect
number:

abcdefgh(8 degree)  and if a multiply with the most right one 'h' , it
becomes h*abcdefgh=aaaaaaaaa (9 degree). I am new to this language and
couldn't solve, any idea ?

Best regards,

-p-

here is my code: please help!

sum9(X9,Y):-

        Y is X9+
        10*X9+
        100 * X9+
        (10**3)*X9+
        (10**4)*X9+
        (10**5)*X9+
        (10**6)*X9+
        (10**7)*X9+
        (10**8)*X9.

septo8(Y,X8,X1):-
        X1 is Y mod 10,
        X8 is (Y // 10**7) mod 10.

find(Init,R):-
        septo8(Init,X8,X1),
        R is X1 * Init,
        sum9(X8,T),
        T \== R,        
        Number is Init + 1,
        test(Number,M).

Acting on the assumption that the domain is decimal digits and each
variable is a unique digit then my crypto-arithmetic processor finds no
solution!

Ray Reeves

aa.cry file:

 ABCDEFGH
        H
---------
.........
---------
AAAAAAAAA

aa.pro file:

%% Code generated by crypto on 3/26/2002.

:- dcg_terminal(draw).
:- noNonTerminals.

aa :-
    solution(aa,[0, 1, 2, 3, 4, 5, 6, 7, 8, 9], X).

solution(aa) -->
   [H], H > 0,
   evaluate(H * H + 0, ProdCarry49, R49),
   *[R49],
   evaluate(0 + R49 , SumCarry9, A),
   [A], A > 0,
   [G],
   evaluate(G * H + ProdCarry49, ProdCarry48, R48),
   *[R48],
   evaluate(SumCarry9 + R48 , SumCarry8, A),
   [F],
   evaluate(F * H + ProdCarry48, ProdCarry47, R47),
   *[R47],
   evaluate(SumCarry8 + R47 , SumCarry7, A),
   [E],
   evaluate(E * H + ProdCarry47, ProdCarry46, R46),
   *[R46],
   evaluate(SumCarry7 + R46 , SumCarry6, A),
   [D],
   evaluate(D * H + ProdCarry46, ProdCarry45, R45),
   *[R45],
   evaluate(SumCarry6 + R45 , SumCarry5, A),
   [C],
   evaluate(C * H + ProdCarry45, ProdCarry44, R44),
   *[R44],
   evaluate(SumCarry5 + R44 , SumCarry4, A),
   [B],
   evaluate(B * H + ProdCarry44, ProdCarry43, R43),
   *[R43],
   evaluate(SumCarry4 + R43 , SumCarry3, A),
   evaluate(A * H + ProdCarry43, R41, R42),
   [R41],  R41 > 0,
   *[R42],
   evaluate(SumCarry3 + R42 , SumCarry2, A),
   evaluate(SumCarry2 + R41 , 0, A),
   displayGram(9, 6,
               ['R42', 'R43', 'B', 'R44', 'C', 'R45', 'D', 'R46', 'E',
'R47', 'F', 'R48', 'G', 'A', 'R49', 'H'],
               [R42, R43, B, R44, C, R45, D, R46, E, R47, F, R48, G, A,
R49, H]    ).

pos('A', 2, 1, 0).
pos('B', 3, 1, 0).
pos('C', 4, 1, 0).
pos('D', 5, 1, 0).
pos('E', 6, 1, 0).
pos('F', 7, 1, 0).
pos('G', 8, 1, 0).
pos('H', 9, 1, 0).
pos('H', 9, 2, 0).
pos('R41', 1, 4, 1).
pos('R42', 2, 4, 1).
pos('R43', 3, 4, 1).
pos('R44', 4, 4, 1).
pos('R45', 5, 4, 1).
pos('R46', 6, 4, 1).
pos('R47', 7, 4, 1).
pos('R48', 8, 4, 1).
pos('R49', 9, 4, 1).
pos('A', 1, 6, 0).
pos('A', 2, 6, 0).
pos('A', 3, 6, 0).
pos('A', 4, 6, 0).
pos('A', 5, 6, 0).
pos('A', 6, 6, 0).
pos('A', 7, 6, 0).
pos('A', 8, 6, 0).
pos('A', 9, 6, 0).
barLine(1, 3, real).
barLine(2, 5, real).

GNU Prolog finite domains gets a perfectly good answer almost
immediately...

% -*- prolog -*-
digit(X) :- X #=< 9, X #>= 0.
nonzero(X) :- X #>= 1, X #=< 9.
numeric(X) :- member(X, [0,1,2,3,4,5,6,7,8,9]).
solution(X) :-
        fd_all_different([A,B,C,D,E,F,G,H]),
        digit(A), digit(B), digit(C), digit(D), digit(E), digit(F),
        digit(G), digit(H),
        T1 #= H * 1 + G * 10 + F * 100 + E * 1000 + D * 10000 +
                 C * 100000 + B * 1000000 + A * 10000000,
        T2 #= H * T1,
        T2 #= A * 1 + A * 10 + A * 100 + A * 1000 + A * 10000 +
                 A * 100000 + A * 1000000 + A * 10000000 + A * 100000000 ,
        numeric(A), numeric(B), numeric(C), numeric(D),
        numeric(E), numeric(F), numeric(G), numeric(H),
        X=[T1, T2].
--

http://www.ntlug.org/~cbbrowne/finances.html
"High-level languages are a pretty good indicator that all else is
seldom equal." - Tim Bradshaw, comp.lang.lisp

Thanks for the bug report, even though you blew my cover.
Here it is again. Use fixed font to read this.

Ray Reeves

?- [crypto, cryptolib, setup].

yes
?- main.

CRYPTO-ARITHMETIC PUZZLES
fun
gerald
goodnight
money1
money2
ocean
primes(+ [2, 3, 5, 7])
schuh([0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9])
toohard
trente
twenty
vier
xroads
try
aa

Select puzzle name:

aa.
Problem: (aa.cry), Domain: [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] :

 ABCDEFGH
        H
---------
AAAAAAAAA
---------
AAAAAAAAA

Generating solution code (aa.pro):
time: 0.1599998 seconds

Executing solution code:

 12345679
        9
---------
111111111
---------
111111111

no more solutions
time for all solutions: 0.1100006 seconds

%% Code generated by crypto on 3/28/2002.

:- dcg_terminal(draw).
:- noNonTerminals.

aa :-
    solution(aa,[0, 1, 2, 3, 4, 5, 6, 7, 8, 9], X).

solution(aa) -->
   [H], H > 0,
   evaluate(H * H + 0, ProdCarry49, A),
   [A], A > 0,
   evaluate(0 + A , SumCarry9, A),
   [G],
   evaluate(G * H + ProdCarry49, ProdCarry48, A),
   evaluate(SumCarry9 + A , SumCarry8, A),
   [F],
   evaluate(F * H + ProdCarry48, ProdCarry47, A),
   evaluate(SumCarry8 + A , SumCarry7, A),
   [E],
   evaluate(E * H + ProdCarry47, ProdCarry46, A),
   evaluate(SumCarry7 + A , SumCarry6, A),
   [D],
   evaluate(D * H + ProdCarry46, ProdCarry45, A),
   evaluate(SumCarry6 + A , SumCarry5, A),
   [C],
   evaluate(C * H + ProdCarry45, ProdCarry44, A),
   evaluate(SumCarry5 + A , SumCarry4, A),
   [B],
   evaluate(B * H + ProdCarry44, ProdCarry43, A),
   evaluate(SumCarry4 + A , SumCarry3, A),
   evaluate(A * H + ProdCarry43, A, A), A > 0,
   evaluate(SumCarry3 + A , SumCarry2, A),
   evaluate(SumCarry2 + A , 0, A),    A > 0,
   displayGram(9, 6,
               ['B', 'C', 'D', 'E', 'F', 'G', 'A', 'H'],
               [B, C, D, E, F, G, A, H] ).

pos('A', 2, 1, 0).
pos('B', 3, 1, 0).
pos('C', 4, 1, 0).
pos('D', 5, 1, 0).
pos('E', 6, 1, 0).
pos('F', 7, 1, 0).
pos('G', 8, 1, 0).
pos('H', 9, 1, 0).
pos('H', 9, 2, 0).
pos('A', 1, 4, 0).
pos('A', 2, 4, 0).
pos('A', 3, 4, 0).
pos('A', 4, 4, 0).
pos('A', 5, 4, 0).
pos('A', 6, 4, 0).
pos('A', 7, 4, 0).
pos('A', 8, 4, 0).
pos('A', 9, 4, 0).
pos('A', 1, 6, 0).
pos('A', 2, 6, 0).
pos('A', 3, 6, 0).
pos('A', 4, 6, 0).
pos('A', 5, 6, 0).
pos('A', 6, 6, 0).
pos('A', 7, 6, 0).
pos('A', 8, 6, 0).
pos('A', 9, 6, 0).
barLine(1, 3, real).
barLine(2, 5, real).

 Very good point, I was thinking like in C not prolog, I use
SWI-prolog and there is some difference with gnu's. I have modified
your program, for example I made a random number generater that gives
different digits each time for your function
"fd_all_different([A,B,C,D,E,F,G,H])", but in SWI cannot use #=
syntax,
so, I coulnt make the program back tracking:

del(X,[X|Tail],Tail).
del(X,[Y|Tail],[Y|Tail1]):-
        del(X,Tail,Tail1).

random_list(List,Term):-
        length(List,MaxIndice),
        MaxRandom is MaxIndice+1,
        random(1,MaxRandom,NbElement),
        element_of_list(List,NbElement,Term).

element_of_list([],_,_):-!,fail.
element_of_list([X|L],1,X):-!.
element_of_list([_|L],I,X):-I > 1,I2 is I - 1,element_of_list(L,I2,X).

solution(X) :-

        NumericList=[0,1,2,3,4,5,6,7,8,9],
        PozitifNumericList=[1,2,3,4,5,6,7,8,9],

        random_list(PozitifNumericList,A),del(A,NumericList,LB),
        random_list(LB,B),del(B,LB,LC), %removes the selected one from the
list
        random_list(LC,C),del(C,LC,LD),
        random_list(LD,D),del(D,LD,LE),
        random_list(LE,E),del(E,LE,LF),
        random_list(LF,F),del(F,LF,LG),
        random_list(LG,G),del(G,LG,LH),
        random_list(LH,H),

        T1 is H * 1 + G * 10 + F * 100 + E * 1000 + D * 10000 +
                  C * 100000 + B * 1000000 + A * 10000000,              

        T2 is H * T1,

        T2 is A * 1 + A * 10 + A * 100 + A * 1000 + A * 10000 +
                 A * 100000 + A * 1000000 + A * 10000000 + A *
100000000 ,

        X=[T1, T2].

my version is simple, but very, very, slow...

mknum([H], H):-integer(H).

mknum([H,Y|T], N):- integer(H), integer(Y),Z is H*10+Y, mknum([Z|T], N).

my_length([], 0).
my_length([_|T], N):-my_length(T,M), N is M+1.

my_last([H], H).
my_last([_|T], Y):-my_last(T,Y).

mklist(0, _, []).
mklist(N,X,[X|T]):-M is N-1, mklist(M, X, T).

perfect([X|T], N):-my_length([X|T],N), my_last([X|T], Z), M is
N+1,mklist(M,X,R), mknum(R,Num), mknum([X|T], Num2), !,Num is Num2*Z.

int(0).
int(N):-int(M), N is M+1.

dig(0).
dig(1).
dig(2).
dig(3).
dig(4).
dig(5).
dig(6).
dig(7).
dig(8).
dig(9).

numlist([],0):-!.
numlist([X|T],N):-M is N-1,numlist(T, M),dig(X).

soln(N, [X|T]):-numlist([X|T],N), X > 0, perfect([X|T],N).

?-soln(8, X).

[wait for an hour or so]

X=[1,2,3,4,5,6,7,9];

[another hour or so]

no

All such puzzles can solved according to a scheme that is exemplified by the solution that follows:

/*

      A1 A2 A3 A4 A5 A6 A7 A8
    *                                        A8
 ======================
A1 A1 A1 A1 A1 A1 A1 A1 A1

*/

perfect([A1,A2,A3,A4,A5,A6,A7,A8]) :-
        digit(A8),
        mult(A8,A8,0,A1,C1),
        A1 > 0,
        digit(A7),
        mult(A8,A7,C1,A1,C2),
        digit(A6),
        mult(A8,A6,C2,A1,C3),
        digit(A5),
        mult(A8,A5,C3,A1,C4),
        digit(A4),
        mult(A8,A4,C4,A1,C5),
        digit(A3),
        mult(A8,A3,C5,A1,C6),
        digit(A2),
        mult(A8,A2,C6,A1,C7),
        digit(A1),
        mult(A8,A1,C7,A1,A1).

digit(0).
digit(1).
digit(2).
digit(3).
digit(4).
digit(5).
digit(6).
digit(7).
digit(8).
digit(9).

mult(X,Y,Cin,R,Cout) :-
        A is X*Y+Cin,
        (A < 10 ->
            R = A,
            Cout = 0
        ;
            Cout is A // 10,
            R is A mod 10
        ).

Cheers

Bart Demoen

 Wavv, congratulaions, you think the way of prolog.

Great code, thanks! :-)

To explore this a little bit further, it is straightforward to
take your approach to find such numbers of any length:

%% try to find N digits.
% perfect( +N, -Digits)
perfect(N,[A1|As]):-
  N>0, multn(N,[A1|As],A1,A1,_).

% multn(+N,-Ldigs,-Cout,--Dig1st,--Diglast)
multn( 1, [Dlast], C, D1, Dlast):-
  !, digit(Dlast), Dlast > 0,
  mult( Dlast, Dlast, 0, D1, C).
multn( N, [A|As], Cout, D1, Dlast):-
  N1 is N-1,  multn( N1, As, C2, D1, Dlast),
  digit(A),  mult( Dlast, A, C2, D1, Cout).

% find all such numbers up to Nmax digits length
nperfect(Nmax):-
  nperfect(1,Nmax).
nperfect(Nstart,Nend):-
  Nstart > Nend, !.
nperfect(N,Nend):-
  ( perfect(N,L), nl,write(N),write(': '),write(L),fail -> true ; true),
  N1 is N+1,
  nperfect(N1,Nend).

/* test:
?- nperfect(40).

8: [1,2,3,4,5,6,7,9]
17: [1,2,3,4,5,6,7,9,0,1,2,3,4,5,6,7,9]
26: [1,2,3,4,5,6,7,9,0,1,2,3,4,5,6,7,9,0,1,2,3,4,5,6,7,9]
35: [1,2,3,4,5,6,7,9,0,1,2,3,4,5,6,7,9,0,1,2,3,4,5,6,7,9,0,1,2,3,4,5,6,7,9]
yes
?- */

I'll be grateful for you to point out any shortcomings of this code. :-)

Vladimir.

%%% your code used here:
digit(0).
digit(1).
digit(2).
digit(3).
digit(4).
digit(5).
digit(6).
digit(7).
digit(8).
digit(9).

mult(X,Y,Cin,R,Cout) :-
        A is X*Y+Cin,
        (A < 10 ->
            R = A,
            Cout = 0
        ;
            Cout is A // 10,
            R is A mod 10
        ).

---
Vlad   http://vnestr.tripod.com/