[net.lang.prolog] The Lamps Puzzle.

Gabriel%ANL-MCS@sri-unix.UUCP (01/08/84)

From:  Gabriel@ANL-MCS (John Gabriel)

Here is a solution to the "lamps" problem posed in Vol 2, #1.

I am not sure if the setter will agree that it complies with
the condition "no generate and search", and therein lies its
real interest.

First a few notes about knowledge representation. I have
chosen to use a formalism where signal names "a" or "b" are
bound to values "on" or "off", using a predicate

signal(NAME,VALUE).

This trick allows me to do the equivalent of asking about
VALUE(NAME), without becoming entangled in apparent second
order calculus. Database people or users of the McCabe Prolog
will recognise this as simply working with triplets [signal,
VALUE,NAME] instead of doublets [VALUE,NAME].  The job could
equally well be done using lists or sets.

Second, about generate and search. There seem to me to be two
issues, first the presence of backtracking blurs the distinction
between "conjunction of goals" and "generate and search" so much
that one might argue the only non "generate and search" solution
was one that never backtracks. The two predicates

state([a,on],[b,off]).
state([a,off],[b,on]).

certainly meet this criterion but demand fairly extensive knowledge
transformation by the programmer to reach them from the problem as
stated. If we do not allow this, then any reasonable solution seems
to me to require a conjunction of goals essentially the same as the
problem statement, and inevitably causes a generate and search by
backtracking. So the question becomes "Can we arrange the goals
so as to minimise or eliminate backtracking ?" Experience here using
'Jobs' puzzles as tests for resolution based theorem provers
suggests the answer is at best "We cannot always eliminate all
backtracking without more powerful resolution methods than are used
by Prolog, and perhaps not even then. But judicious reformulation
of the problem in Prolog by reordering goals alone can gain a
factor of 30 in execution speed for a program in CProlog. In fact
an interesting offshoot of that observation is a project to
"compile" jobs problems in natural language to optimal Prolog.
I have not embarked on this, but I do have some similar work in
progress compiling build specifications for logic circuits to
rules determining the I/O behaviour of the system.

Here is a solution with a "conjunction of goals and backtracking":-

/* signal binds a name to a value, E.g. signal(a,on) says the
   signal a has value on. The following two predicates ensure
   that signals take values off and on */

signal(_,on).
signal(_,off).

condition(A,B):- /* applies the conditions of the problem */
  signal(_,A),
  signal(_,B), /* each signal must be off or on */
  (([A,B] = [off,on]) ; ([A,B] = [on,off])), /* if A is off,
   B is on etc. */

  ((A = on) ; (B = on)). /* one of A or B is on */

state([a,A],[b,B]):- /* valid system states */
        condition(A,B).

Here is another more elegant and concise solution:-

valid(on).
valid(off).

state([a,A],[b,B]):-
        valid(A),
        valid(B),
        or((A = on), (B = on)),
        ifthen((A = on), (B = off)).

or(X,Y):- X,!.
or(X,Y):- Y.

ifthen(X,Y):- /* not(X) or Y */
        not(call(X)),
        !.
ifthen(X,Y):-
        call(Y).

Perhaps the Jobs Puzzle and two of the solutions may be of
interest. I am indebted to Linda Mazur for the puzzle which
is part of a collection of similar material from the literature
on logic.

- Four ladies meet regularly to play cards, each has one and
  only one job. Their names are:- Alice, Betty, Carol and Dorothy;
  the jobs are pilot, lifeguard, housewife, and professor.
- At one meeting the colors of their dresses were pink, yellow,
  blue and white.
- The pilot and Carol played bridge with the ladies in pink and
  blue dresses.
- Betty always beats the lifeguard when canasta is played.
- Alice and the professor both envy the lady in blue, who is
  not the housewife, since the housewife always wears white.
- Who has which job, and what dress was each lady wearing on
  the day of the bridge game mentioned above.

facts:- /* facts for Jobs Puzzle */

/* jobs and dress collors for alice,betty,carol,dorothy */
person(alice,AJOB,ADRESS),
person(betty,BJOB,BDRESS),
not(AJOB=BJOB),not(ADRESS=BDRESS),
person(carol,CJOB,CDRESS),
not(AJOB=CJOB),not(ADRESS=CDRESS),not(BJOB=CJOB),not(BDRESS=CDRESS),
person(dorothy,DJOB,DDRESS),
not(AJOB=DJOB),not(ADRESS=DDRESS),not(BJOB=DJOB),not(BDRESS=DDRESS),
        not(CJOB=DJOB),not(CDRESS=DDRESS),

/* set out the bindings */

BINDING=[[alice,AJOB,ADRESS],
        [betty,BJOB,BDRESS],
        [carol,CJOB,CDRESS],
        [dorothy,DJOB,DDRESS]],
not(BJOB=lifeguard), /* cnasta*/
not(CJOB=pilot), /*bridge - carol isnt pilot */
not(CDRESS=pink), /* bridge-carol plays w/ lady in pink */
not(CDRESS=blue), /* bridge */
not(AJOB=professor),
not(ADRESS=blue), /* both from data on envy*/
not(member(BINDING,[_,pilot,pink])),
not(member(BINDING,[_,pilot,blue])),
not(member(BINDING,[_,professor,blue])),
not(member(BINDING,[_,housewife,blue])),
member(BINDING,[_,housewife,white]),
nl,write(alice),cma,write(AJOB),cma,write(ADRESS),
nl,write(betty),cma,write(BJOB),cma,write(BDRESS),
nl,write(carol),cma,write(CJOB),cma,write(CDRESS),
nl,write(dorothy),cma,write(DJOB),cma,write(DDRESS).

cma:- write(',').
jobs([housewife,pilot,professor,lifeguard]). /*valid jobs */

names([alice,betty,carol,dorothy]). /*valid names */

colors([pink,blue,yellow,white]).

person(NAME,JOB,COLOR):- /*attributes of a person */
        names(NAMES),
        jobs(JOBS),
        colors(COLORS),
        member(NAMES,NAME),
        member(JOBS,JOB),
        member(COLORS,COLOR).

/* service routines follow to test if all members of a list are
   distinct */

/* distinct fails unless all members of a list are distinct,
   non-variable */

distinct([]). /* if we processed the whole list w/o failure we
   succeed */

distinct([H|T]):-
        nonvar(H), /* Is H instantiated? */
        not(member(T,H)), /* Is H present in the rest of the list */
        /* if we got to here H is distinct from any element in T
        the remainder of the list, now repeat for rest of list */
        distinct(T).

member([],ITEM):- fail. /* if we got to empty list, then fail */
/* ITEM is in a list either if it is the first item in the list
I.e. H of [H|T] or in T, the rest of the list */

member([H|T],ITEM):-
        ((H = ITEM) ; member(T,ITEM)).

Here is a faster solution:-

facts:-
possible(alice,AJOB,ADRESS),
possible(betty,BJOB,BDRESS),
APROP=[AJOB,ADRESS],
BPROP=[BJOB,BDRESS],
nident(APROP,BPROP),
possible(carol,CJOB,CDRESS),
CPROP=[CJOB,CDRESS],
nident(APROP,CPROP),
nident(BPROP,CPROP),
possible(dorothy,DJOB,DDRESS),
DPROP=[DJOB,DDRESS],
nident(APROP,DPROP),
nident(BPROP,DPROP),
nident(CPROP,DPROP),
nl,write(alice),cma,write(APROP),
nl,write(betty),cma,write(BPROP),
nl,write(carol),cma,write(CPROP),
nl,write(dorothy),cma,write(DPROP).

cma:- write(',').

possible(NAME,JOB,DRESS):-
member([alice,betty,carol,dorothy],NAME),
member([yellow,pink,blue,white],DRESS),
member([pilot,lifeguard,professor,housewife],JOB),
ifthen((JOB=housewife),(DRESS=white)),
ifthen((DRESS=white),(JOB=housewife)),
nand(NAME=betty,JOB=lifeguard),
nand(NAME=carol,JOB=pilot),
nand(NAME=carol,DRESS=pink),
nand(NAME=alice,JOB=professor),
nand(NAME=carol,DRESS=blue),
nand(NAME=alice,DRESS=blue),
nand(JOB=pilot,DRESS=blue),
nand(JOB=professor,DRESS=blue),
nand(JOB=housewife,DRESS=blue).

nand(X,Y):-
call(X),
call(Y),
!,fail.
nand(_,_).

ifthen(X,Y):- /* (not X) or Y */
not(call(X)).
ifthen(X,Y):-
call(Y).

nident([],[]).
nident([H1|T1],[H2|T2]):-
        not(H1=H2),
        nident(T1,T2).
member([],ITEM):- fail. /* if we got to empty list, then fail */

/* ITEM is in a list either if it is the first item in the list
i.e. H of [H|T] or in T, the rest of the list */

member([H|T],ITEM):-
        ((H = ITEM) ; member(T,ITEM)).

Those readers who worked on the Tigers puzzle of the last issue
of Vol.1 may be interested to try these techniques for that case.

Also E. Sacerdoti in his book on "Planner" type problems makes
some interesting points about a plan being a solution to a
constrained conjunction of goals, and the continuum from generate
and test to deterministic solution.  If one can generate a nearly
deterministic solution by "compilation", it seems to me that matches
some forms of human reasoning quite well too.

-- John Gabriel