Perfect Number 
Author Message
 Perfect Number

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-



Sat, 11 Sep 2004 19:00:01 GMT  
 Perfect Number

Quote:

> 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).



Sun, 12 Sep 2004 05:55:45 GMT  
 Perfect Number
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).

Quote:

>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-



Mon, 13 Sep 2004 01:25:22 GMT  
 Perfect Number

Quote:
> 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!

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



Mon, 13 Sep 2004 06:00:49 GMT  
 Perfect Number


Quote:
> In an attempt to throw the authorities off his trail, hawkaccess


Quote:
> > 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!

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

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).



Tue, 14 Sep 2004 03:18:03 GMT  
 Perfect Number

Quote:


> > 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!

> 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].

 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].



Tue, 14 Sep 2004 03:36:10 GMT  
 Perfect Number
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



Wed, 15 Sep 2004 00:56:50 GMT  
 Perfect Number

Quote:

> 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-

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



Wed, 15 Sep 2004 06:14:00 GMT  
 Perfect Number

Quote:


> > 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-

 Wavv, congratulaions, you think the way of prolog.
Quote:
> 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



Wed, 15 Sep 2004 16:32:40 GMT  
 Perfect Number
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
        ).

Quote:

>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

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


Thu, 23 Sep 2004 09:02:35 GMT  
 
 [ 10 post ] 

 Relevant Pages 

1. New user need help with perfect numbers.

2. Perfect Numbers

3. Perfect Numbers

4. ASM to test Perfect Number

5. Finding perfect numbers

6. Perfect Numbers, Complexity

7. Yet another perfect number program

8. Yet another perfect number program

9. perfect numbers

10. Numbers Numbers Numbers

11. Perfect example of why subclassing can be dangerous...

12. Golf - The perfect problem to compare languages with?

 

 
Powered by phpBB® Forum Software