Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!linus!philabs!seismo!hao!hplabs!sri-unix!Suwa@Sumex-AIM
From: Suwa@Sumex-AIM@sri-unix.UUCP
Newsgroups: net.ai
Subject: Puzzle Solution
Message-ID: <11952@sri-arpa.UUCP>
Date: Mon, 19-Sep-83 05:25:41 EDT
Article-I.D.: sri-arpa.11952
Posted: Mon Sep 19 05:25:41 1983
Date-Received: Tue, 27-Sep-83 02:11:38 EDT
Lines: 88

From:  Motoi Suwa <Suwa@Sumex-AIM>

                 [Reprinted from the Prolog Digest.]

    Date: 14 Sep. 1983
    From: K.Handa  ETL Japan
    Subject: Another Puzzle Solution

This is the solution of Alan's puzzle introduced on 24 Aug.

  ?-go(10).

will display the ten disgit number as following:

  -->6210001000

and

  ?-go(4).

will:

  -->1210
  -->2020

I found following numbers:

  6210001000
   521001000
    42101000
     3211000
       21200
        1210
        2020

The Following is the total program ( DEC10 Prolog Ver.3 )



/*** initial assertion ***/

init(D):- ass_xn(D),assert(rest(D)),!.

ass_xn(0):- !.
ass_xn(D):- D1 is D-1,asserta(x(D1,_)),asserta(n(D1)),ass_xn(D1).

/*** main program ***/

go(D):- init(D),guess(D,0).
go(_):- abolish(x,2),abolish(n,1),abolish(rest,1).

/* guess 'N'th digit */

guess(D,D):- result,!,fail.
guess(D,N):- x(N,X),var(X),!,n(Y),N=<Y,N*Y=<D,ass(N,Y),set(D,N,Y),
           N1 is N+1,guess(D,N1).
guess(D,N):- x(N,X),set(D,N,X),N1 is N+1,guess(D,N1).

/* let 'N'th digit be 'X' */

ass(N,X):- only(retract(x(N,_))),asserta(x(N,X)),only(update(1)).
ass(N,_):- retract(x(N,_)),asserta(x(N,_)),update(-1),!,fail.

only(X):- X,!.

/* 'X' 'N's appear in the sequence of digit */

set(D,N,X):- count(N,Y),rest(Z),!,Y=<X,X=<Y+Z,X1 is X-Y,set1
                                                  (D,N,X1,0).

set1(_,N,0,_):- !.
set1(D,N,X,P):- n(M),P=<M,x(M,Y),var(Y),M*N=<D,ass(M,N),set(D,M,N),
              X1 is X-1,P1 is M,set1(D,N,X1,P1).

/* 'X' is the number of digits which value is 'N' */

count(N,X):- bagof(M,M^(x(M,Z),nonvar(Z),Z=N),L),length(L,X).
count(_,0).

/* update the number of digits which value is not yet assigned */

update(Z):- only(retract(rest(X))),Z1 is X-Z,assert(rest(Z1)).
update(Z):- retract(rest(X)),Z1 is X+Z,assert(rest(Z1)),!,fail.

/* display the result */

result:- print(-->),n(N),x(N,M),print(M),fail.
result:- nl.