Similar Einstein Riddle

I have problem with that task:

Friends: Jarek, Frank, Stefanie, Albert, Simon, Robert, Marcin
they live in one building, each on a different level (0, 1, 2, …).
Each of them has a different animal:
dog, a cat, a fish, hamster, parrot, snake, canary.
In which floort each of them lives and what kind of animal does it have when bellow sentences are true?

Franek lives lower than Albert. The owner of the parrot lives on floor 6. The canary owner lives on floor 0. Franek has no snake. The snake owner lives on floor 1. Albert doesn’t have a canary. Jarek doesn’t have a parrot. Simon has no snake. Robert has no hamsters. The hamster owner lives on floor 3. Robert lives lower than Stefan. Szymon lives lower than Marcin. Marcin has no fish. The owner of the fish lives on floor 4. Franek doesn’t have a hamster. Albert lives lower than Stefan. The cat owner lives on floor 5. The dog owner lives on floor 2. Szymon lives lower than Jarek. Robert lives higher than Albert. Albert doesn’t have a dog. Franek doesn’t have a dog. Stefan doesn’t have a canary. Franek doesn’t have a cat. Marcin lives higher than Jarek. Stefan doesn’t have a parrot. Franek lives lower than Marcin. Marcin doesn’t have a snake. Marcin lives higher than Albert. Franek has no fish. Szymon lives higher than Stefan. Robert has no fish. Stefan lives higher than Franek. Simon lives higher than Albert. Robert doesn’t have a cat. Marcin lives higher than Robert. Franek lives lower than Szymon. Franek lives lower than Robert. Stefan lives lower than Jarek. Stefan doesn’t have a cat. Jarek lives higher than Franek. Stefan doesn’t have a dog. Jarek lives higher than Robert. Franek doesn’t have a parrot. Stefan has no snake. Albert has no fish. Robert lives lower than Simon. Jarek lives higher than Albert. Albert doesn’t have a cat. Stefan lives lower than Marcin. Albert doesn’t have a parrot. Stefan has no fish. Simon doesn’t have a parrot. Simon doesn’t have a cat. Albert doesn’t have a hamster. Jarek doesn’t have a dog. Simon doesn’t have a hamster. Marcin doesn’t have a dog. Simon doesn’t have a canary. Simon doesn’t have a dog.

I have idea to create two tables with animals and number of floors and then by select check all sentences but I dont know how to crate predicate to check if owner of any animal lives on given floor.

Example: einstein/einstein.pl at 87ca91d4288df1590566b5527d511ed06bc99c20 · afvanwoudenberg/einstein · GitHub

My solution looks like this:

puzzle(Table) :-
  Table = [row(_, 0, canary),  % The canary owner lives on floor 0.
           row(_, 1, snake),   % The snake owner lives on floor 1.
           row(_, 2, dog),     % The dog owner lives on floor 2.
           row(_, 3, hamster), % The hamster owner lives on floor 3.
           row(_, 4, fish),     % The owner of the fish lives on floor 4.
           row(_, 5, cat),     % The cat owner lives on floor 5.
           row(_, 6, parrot)], % The owner of the parrot lives on floor 6.
  memberchk(row('Frank', LFrank, AFrank), Table),
  memberchk(row('Albert', LAlbert, AAlbert), Table),
  memberchk(row('Robert', LRobert, ARobert), Table),
  memberchk(row('Stefanie', LStefanie, AStefanie), Table),
  memberchk(row('Simon', LSimon, ASimon), Table),
  memberchk(row('Jarek', LJarek, AJarek), Table),
  memberchk(row('Marcin', LMarcin, AMarcin), Table),
  % Frank has no snake.
  % Frank doesn’t have a dog.
  % Frank doesn’t have a hamster.
  % Franek has no fish. 
  % Frank doesn’t have a cat.
  % Franek doesn’t have a parrot.
  \+ memberchk(AFrank, [snake, dog, hamster, fish, cat, parrot]),
  % Albert doesn’t have a canary.
  % Albert doesn’t have a dog.
  % Albert doesn’t have a hamster.
  % Albert has no fish. 
  % Albert doesn’t have a cat.  
  % Albert doesn’t have a parrot.
  \+ memberchk(AAlbert, [canary, dog, hamster, fish, cat, parrot]),
  % Robert has no hamsters.
  % Robert has no fish. 
  % Robert doesn’t have a cat.   
  \+ memberchk(ARobert, [hamster, fish, cat]),
  % Stefan doesn’t have a canary.
  % Stefan has no snake.
  % Stefan doesn’t have a dog.
  % Stefan has no fish. 
  % Stefan doesn’t have a cat.    
  % Stefan doesn’t have a parrot.
  \+ memberchk(AStefanie, [canary, snake, dog, fish, cat, parrot]),
  % Simon doesn’t have a canary.
  % Simon has no snake.
  % Simon doesn’t have a dog.
  % Simon doesn’t have a hamster. 
  % Simon doesn’t have a cat.  
  % Simon doesn’t have a parrot. 
  \+ memberchk(ASimon, [canary, snake, dog, hamster, cat, parrot]),
  % Jarek doesn’t have a dog. 
  % Jarek doesn’t have a parrot. 
  \+ memberchk(AJarek, [dog, parrot]),
  % Marcin doesn’t have a snake.
  % Marcin doesn’t have a dog.
  % Marcin has no fish.
  \+ memberchk(AMarcin, [snake, dog, fish]),
  LFrank < LAlbert,    % Frank lives lower than Albert.
  LFrank < LRobert, % Franek lives lower than Robert. 
  LFrank < LStefanie, % Stefan lives higher than Franek.
  LFrank < LSimon, % Franek lives lower than Szymon.
  LFrank < LJarek, % Jarek lives higher than Franek.
  LFrank < LMarcin, % Franek lives lower than Marcin.
  LAlbert < LRobert, % Robert lives higher than Albert. 
  LAlbert < LStefanie, % Albert lives lower than Stefan. 
  LAlbert < LSimon, % Simon lives higher than Albert.
  LAlbert < LJarek, % Jarek lives higher than Albert.
  LAlbert < LMarcin, % Marcin lives higher than Albert. 
  LRobert < LStefanie, % Robert lives lower than Stefan.
  LRobert < LSimon, % Robert lives lower than Simon.
  LRobert < LJarek, % Jarek lives higher than Robert.
  LRobert < LMarcin, % Marcin lives higher than Robert. 
  LStefanie < LSimon, % Szymon lives higher than Stefan. 
  LStefanie < LJarek, % Stefan lives lower than Jarek. 
  LStefanie < LMarcin, % Stefan lives lower than Marcin.
  LSimon < LJarek, % Szymon lives lower than Jarek. 
  LSimon < LMarcin, % Szymon lives lower than Marcin.  
  LJarek < LMarcin. % Marcin lives higher than Jarek.

Which gives the solution:

Friend Floor Pet
Frank 0 canary
Albert 1 snake
Robert 2 dog
Stefanie 3 hamster
Simon 4 fish
Jarek 5 cat
Marcin 6 parrot

My general recipe for doing this kind of puzzle in Prolog is first create a tempate as in

Table = [row(Friend0, Level0, Pet0),
         row(Friend1, Level1, Pet1),
             ....
]

first filling whatever column has some kind of numerical order (level or floor in this example) to pin the solution down so there aren’t every possible permutation in the end.

Next do the memberchk(row('Frank', LFrank, AFrank), Table), for each provided name in this case. I cheated in the above by ordering these as the solution became clearer, but it doesn’t make any difference to Prolog what order these are. Finally, translate the provided clues into Prolog (which I find very educational).

This example is a bit verbose, with a lot of redundant clues.

1 Like

My solution does not look as easy as yours, but your solution is indeed hard to understand for me. I still don’t believe I would be able to find your solution by myself. Maybe tomorow. But I have to say it was not clear for me how complicated the task actually is. I thought there were more possible logical and different dependencies, for instance an incomplete list of the ‘owners pet to floor’ relation and not such a straight ‘who don’t own which pet’, and an incomplete ‘who lives under whom’, so the rest had to be inferred anyhow.

I believe this task is very redundant in its data. But I didn’t knew that. Maybe that is the point.


:- use_module( library( clpfd)).
:- use_module(library( ugraphs)).
:- use_module(library( yall)).

:- op( 13, xfx, has).
:- op( 13, xfx, lives).
:- op( 12, xfx, than).
:- op( 11, fx, on).
:- op( 10, fx, floor).
:- op( 9, xfx, of).
:- op( 8, fx, the).
:- op( 7, xf, owner).
:- op( 6, fx, no).
:- op( 5, xf, doesn_t).
:- op( 7, xfx, have).
:- op( 3, fx, a).


rules( franek lives lower than albert).
rules( the owner of the parrot lives on floor 6).
rules( the canary owner lives on floor 0).
rules( franek has no snake).
rules( the snake owner lives on floor 1).
rules( albert doesn_t have a canary).
rules( jarek doesn_t have a parrot).
rules( simon has no snake).
rules( robert has no hamsters).
rules( the hamster owner lives on floor 3).
rules( robert lives lower than stefan).
rules( szymon lives lower than marcin).
rules( marcin has no fish).
rules( the owner of the fish lives on floor 4).
rules( franek doesn_t have a hamster).
rules( albert lives lower than stefan).
rules( the cat owner lives on floor 5).
rules( the dog owner lives on floor 2).
rules( szymon lives lower than jarek).
rules( robert lives higher than albert).
rules( albert doesn_t have a dog).
rules( franek doesn_t have a dog).
rules( stefan doesn_t have a canary).
rules( franek doesn_t have a cat).
rules( marcin lives higher than jarek).
rules( stefan doesn_t have a parrot).
rules( franek lives lower than marcin).
rules( marcin doesn_t have a snake).
rules( marcin lives higher than albert).
rules( franek has no fish).
rules( szymon lives higher than stefan).
rules( robert has no fish).
rules( stefan lives higher than franek).
rules( simon lives higher than albert).
rules( robert doesn_t have a cat).
rules( marcin lives higher than robert).
rules( franek lives lower than szymon).
rules( franek lives lower than robert).
rules( stefan lives lower than jarek).
rules( stefan doesn_t have a cat).
rules( jarek lives higher than franek).
rules( stefan doesn_t have a dog).
rules( jarek lives higher than robert).
rules( franek doesn_t have a parrot).
rules( stefan has no snake).
rules( albert has no fish).
rules( robert lives lower than simon).
rules( jarek lives higher than albert).
rules( albert doesn_t have a cat).
rules( stefan lives lower than marcin).
rules( albert doesn_t have a parrot).
rules( stefan has no fish).
rules( simon doesn_t have a parrot).
rules( simon doesn_t have a cat).
rules( albert doesn_t have a hamster).
rules( jarek doesn_t have a dog).
rules( simon doesn_t have a hamster).
rules( marcin doesn_t have a dog).
rules( simon doesn_t have a canary).
rules( simon doesn_t have a dog).

petsingular( hamsters, hamster) :- !.
petsingular( X, X).

namefix( szymon, simon) :- !.
namefix( X, X).

wcall( GOAL) :- call(GOAL), writeln( GOAL).

terms(TERMS) :- TERMS= [_ doesn_t have a _,_ has no _,_ lives lower than _, _ lives higher than _, the owner of the _ lives on floor _, the _ owner lives on floor _].

info001 :- true
 , wcall( aggregate_all( count, rules(_), _) )
 , terms( TERMS)
 , findall( COUNT, ( member( TERM, TERMS), wcall( aggregate_all( count, rules( TERM), COUNT))), LCOUNT)
 , sum_list(LCOUNT, SUM)
 , writeln( LCOUNT - SUM)
 , forall( ( rules( TERM), \+ member( TERM, TERMS)), writeln( rest-TERM))
 .

:- dynamic hasno/2.
:- dynamic petlist/1.
:- dynamic pet/1.
:- dynamic wholist/1.
:- dynamic who/1.

:- dynamic lowerthan/2.

:- dynamic petownerfloor/2.

createdb :- true
 , abolish( hasno/2)
 , abolish( petlist/1)
 , abolish( pet/1)
 , abolish( wholist/1)
 , abolish( who/1)
 , abolish( lowerthan/2)
 , abolish( petownerfloor/2)

 , forall( ( rules( Who doesn_t have a Pet) ; rules( Who has no Pet)), ( petsingular( Pet, PetS), assertz( hasno(Who, PetS))))
 , forall( rules( Who1 lives lower than Who2), ( namefix( Who1, Who1F), namefix( Who2, Who2F), assertz( lowerthan( Who1F, Who2F))))
 , forall( rules( Who1 lives higher than Who2), ( namefix( Who1, Who1F), namefix( Who2, Who2F), assertz( lowerthan( Who2F, Who1F))))
 , forall( ( rules( the owner of the Pet lives on floor F) ; rules( the Pet owner lives on floor F)), assertz( petownerfloor( Pet, F)))

 , {}/( setof( Pet, {Pet}/(hasno( _, Pet);petownerfloor(Pet,_)), L), assertz(petlist(L))) 
 , {}/( setof( Who, {Who}/(hasno( Who, _);lowerthan(Who,_);lowerthan(_,Who)), L), assertz(wholist(L))) 

 , forall( ( petlist(L), member( M, L)), assertz( pet(M)))
 , forall( ( wholist(L), member( M, L)), assertz( who(M)))
 .

:- createdb.

oneof_ownerfloor2( Who, Floor) :- petownerfloor( Pet, Floor), who(Who), \+ hasno(Who, Pet).

oneof_ownerfloor3( Who, CLPFloors) :- true
 , bagof(Floor, Floor^oneof_ownerfloor2( Who, Floor), Floors)
 , Floors = [FH|FT]
 , foldl( [X,Y,RES]>>( RES = Y \/ X ), FT, FH, CLPFloors)
 .

calculate :- true
 , findall( Who-D, ( oneof_ownerfloor3( Who, CLPFloors), D in CLPFloors), WhosL)
 , maplist( [A,B,C]>>(A=B-C), WhosL, Whos, Domains)
 , all_distinct(Domains)
 , maplist( [A,Floor,Whos]>>(petownerfloor(Pet,Floor),A=Floor-Whos-Pet), WhosL2, Domains, Whos)
 , sort(WhosL2, WhosL2Sorted)
 , writeln(WhosL2Sorted)
 .

test001 :- true
  , {}/(findall( A-B, lowerthan(A,B), L), vertices_edges_to_ugraph([],L, U), top_sort( U, S) 
        , writeln( topological_sorted-S) )
 .

And the solution:

(ins)?- calculate.
[0-franek-canary,1-albert-snake,2-robert-dog,3-stefan-hamster,4-simon-fish,5-jarek-cat,6-marcin-parrot]
true.

But the topological sort does also the job:

(ins)?- test001.
topological_sorted-[franek,albert,robert,stefan,simon,jarek,marcin]
true.

Regards.

1 Like

(@Frank_Schwidom: I like your observation that the floor constraints can be topological sorted.)

Here is another clpfd model (in part inspired by @joeblog’s solution) using two lists which collects:

  • which animals does a person not own (NoOwns)
  • for which people does a person live on a lower floor (LowerFloors). All the lower/higher floor constraints has been normalized to lower floor (thanks to @joeblog for this).

The solution:

floor=[1,0,5,6,2,4,3]
owns=[2,1,6,7,3,5,4]
Floor 0 Frank canary
Floor 1 Albert snake
Floor 2 Robert dog
Floor 3 Stefanie hamster
Floor 4 Simon fish
Floor 5 Jarek cat
Floor 6 Marcin parrot

The model:

:- use_module(library(clpfd)).

go :- 
        puzzle(Floor,Owns),
        writeln(floor=Floor),
        writeln(owns=Owns),        

        Animals = [canary,snake,dog,hamster,fish,cat,parrot],
        People = ['Albert','Frank','Jarek','Marcin','Robert','Simon','Stefanie'], % sorted
        numlist(0,6,FloorNums),
        maplist(print_solution(Animals,People,Floor),FloorNums),        
        nl,
        fail,

        nl.
go.

print_solution(Animals,People,Floor, FloorNum) :-
        % Who lives at this floor?
        nth1(P,Floor,FloorNum), % Identify this person's index
        nth1(P,People,Person),  % Get the name
        % What animal is on this floor?
        nth0(FloorNum,Animals,Animal),
        format("Floor ~d ~w ~w\n", [FloorNum,Person,Animal]).

puzzle(Floor,Owns) :-
        N = 7,
        numlist(1,N,Ns),

        % The animals at the different floors
        Animals = Ns,
        % Floor order
        [Canary,Snake,Dog,Hamster,Fish,Cat,Parrot] = Animals, 

        % The people
        People = Ns,  
        [Albert,Frank,Jarek,Marcin,Robert,Simon,Stefanie] = People, 

        % What animal does person P owns?
        length(Owns,N),
        Owns ins 1..N,

        % Which Floor does person P live at?
        N1 is N-1,
        length(Floor,N),
        Floor ins 0..N1,

        all_different(Owns),
        all_different(Floor),

        % [Person, NotOwns]
        NoOwns = [[Frank,    [Snake, Dog, Hamster, Fish, Cat, Parrot]],
                  [Albert,   [Canary, Dog, Hamster, Fish, Cat, Parrot]],
                  [Robert,   [Hamster, Fish, Cat]],
                  [Stefanie, [Canary, Snake, Dog, Fish, Cat, Parrot]],
                  [Simon,    [Canary, Snake, Dog, Hamster, Cat, Parrot]],
                  [Jarek,    [Dog, Parrot]],
                  [Marcin,   [Snake, Dog, Fish]]
                 ],
        maplist(no_owns(Owns),NoOwns),

        % All constraints are converted to lower than (inspired by joeblog's solution)
        % [Floor[Person] < [People]]
        LowerFloors =  [
                   [Frank,    [Albert,Robert,Stefanie,Simon,Jarek,Marcin]],
                   [Albert,   [Robert,Stefanie,Simon,Jarek,Marcin]],
                   [Robert,   [Stefanie,Simon,Jarek,Marcin]],
                   [Stefanie, [Simon,Jarek,Marcin]],
                   [Simon,    [Jarek,Marcin]],
                   [Jarek,    [Marcin]]
                  ],
        maplist(lower_floors(Floor),LowerFloors),
        
        append(Owns,Floor,Vars),
        label(Vars).

%
% Person P doesn't own any animal in the list As.
% 
no_owns(Owns,[P,As]) :-
        maplist(no_own(Owns,P),As).

% Person P does not own animal A
no_own(Owns,P,A) :-
        element(P,Owns,PO),
        PO #\= A.

%
% Person P lives in a floor less than all people in L.
% 
lower_floors(Floor,[P,Ps]) :-
        maplist(lower_floor(Floor,P),Ps).
% Person P live in a floor less than P2.
lower_floor(Floor,P,P2) :-
        element(P,Floor,FloorP),
        element(P2,Floor,FloorP2),
        FloorP #< FloorP2.

The model is also here: http://hakank.org/swi_prolog/friends_at_different_floors.pl

1 Like

Yeah, thanks. But it leaves other constraints unnoticed and so in theory can fail. Unfortunately top_sort is semidet and cannot provide more results even if there were more. The clpfd directive all_distinct with labeling would provide more results in that case and you could see if you have to take other constraints into account.

I have anoter riddle. I found it in different computer games in different variations.

It is possible to solve it in the head but nonetheless I think it is structurally more complicated than the above riddle. Even despite the fact that is significantly shorter.

A Bosmer, was slain. The Altmer claims the Dunmer is guilty. The Dunmer says the Khajiit did it. The Orc swears he didn’t kill the Bosmer. The Khajiit says the Dunmer is lying. If only one of these speaks the truth, who killed the Bosmer?

But the interesting part is how to solve it via prolog or any other solver.

And there is another point. A lot of riddles provide only exactly one solution. What if you modify it so that it can have more than 1 solutions or no solution?

If you add a rule so that you have no perfect solution there could be solutions which have some flaws. And you could be interested in figuring out how to qualify these flaws so that you end up in a solution with a minimum of trade offs.

Then it would also be interesting to use a probabilistic solver like cplint for example. I don’t currently not know exactly if it is possible to solve straight logic riddles in a probabilistic way but we will see.

Regards.

1 Like

I tend to use cllpfd for solving this kind of puzzle (and puzzles in general :-)), so here a clpfd model, using two boolean lists SpeaksTruth and Guilty to keep track who telling the truth and who is guilty. The equivalence constraint (#<==>) is used to connect the parts of statements.

:- use_module(library(clpfd)).

go :- 
          L = [altmer,dunmer,orc,khajiit],

          % Who speaks the truth?
          SpeaksTruth = [AltmerT,DunmerT,OrcT,KhajiitT],
          SpeaksTruth ins 0..1,

          % Who is guilty?
          Guilty = [_AltmerG,DunmerG,OrcG,KhajiitG],
          Guilty ins 0..1,
   
          % A Bosmer, was slain.
  
          % The Altmer claims the Dunmer is guilty.
          AltmerT #<==> DunmerG,

          % The Dunmer says the Khajiit did it.
          DunmerT #<==> KhajiitG,
  
          % The Orc swears he didn?t kill the Bosmer.
          OrcT #<==> (OrcG #= 0),
  
          % The Khajiit says the Dunmer is lying.
          KhajiitT #<==> (DunmerT #= 0),

          % If only one of these speaks the truth, who killed the Bosmer?""
          sum(SpeaksTruth,#=,1),

          % Only one is is guilty
          sum(Guilty, #=,1),

          append(SpeaksTruth,Guilty,Vars),
          label(Vars),
          writeln(speaks_truth=SpeaksTruth),
          writeln(guilty=Guilty),
          nl,
          maplist(print_solution,SpeaksTruth,Guilty,L),
          fail,
          nl.
go.

print_solution(SpeaksTruth,Guilty,T) :-
        Guilty      == 1 -> format("Guilty: ~w~n",[T]) ; true,
        SpeaksTruth == 1 -> format("Speaks truth: ~w~n",[T]) ; true.

Solution:

speaks_truth=[0,0,0,1]
guilty=[0,0,1,0]

Guilty: orc
Speaks truth: khajiit

(http://hakank.org/swi_prolog/who_killed_the_bosmer.pl)

I like the fact that most puzzles has exactly one solution, since it’s then easier to check that a model is correct; I always use fail to be sure that there are no more solutions (though the model can be incorrect anyway). But your suggestion makes it more interesting. Also, some (non logic) puzzles does request the number of solutions, e.g. the 8-queens puzzle.

My intuition is that it is possible since we are dealing with just falsehood and truth (0 and 1), but I might have to eat my words. Perhaps I test this in some probabilistic programming language.

To make this Bosmer puzzle more probabilistic, one might to convert it such as:

A Bosmer, was probably slain. The Altmer claims the Dunmer is probably guilty. The Dunmer probably says the Khajiit did it. The Orc swears he didn’t kill the Bosmer. The Khajiit says the Dunmer might be lying. Was the Bosmer killed?

Note: This is untested.

2 Likes

This might be little (or much) off-topic. Sorry about that.

Regarding a probabilistic model of the Bosmer puzzle, I tried to do this with cplint, but got stuck with the two constraints that there is exactly only one truth speaker and exactly one is guilty.

However, here is a proof-of-concept using the same approach as in my clpfd model. It’s written in WebPPL (http://webppl.org/). The “magic” of this is the condition which makes it possible to state with certainty that something holds. It also helps that WebPPL supports exact probabilities (via enumeration) which is used here.

var model = function() {
    var p = 0.5; // prior probability

    // Speaks the truth?
    var AltmerT = flip(p); // True with prior probability 0.5
    var DunmerT = flip(p);
    var OrcT = flip(p);
    var KhajiitT = flip(p);

    // Is guilty?
    var AltmerG = flip(p);
    var DunmerG = flip(p);
    var OrcG = flip(p);
    var KhajiitG = flip(p);

    // A Bosmer, was slain.
    
    // The Altmer claims the Dunmer is guilty.
    condition(AltmerT == DunmerG);
    
    // The Dunmer says the Khajiit did it.
    condition(DunmerT==KhajiitG);
  
    // The Orc swears he did not kill the Bosmer.
    condition(OrcT == (OrcG == 0));
    
    // The Khajiit says the Dunmer is lying.
    condition(KhajiitT == (DunmerT == 0));

    // If only one of these speaks the truth, who killed the Bosmer?""
    condition(AltmerT + DunmerT + OrcT + KhajiitT == 1);
    condition(AltmerG + DunmerG + OrcG + KhajiitG == 1);

    return {
        altmerT:AltmerT,
        dumberT:DunmerT,
        orcT:OrcT,
        khajiitT:KhajiitT,
        
        altmerG:AltmerG,
        dumberG:DunmerG,
        orcG:OrcG,
        khajiitG:KhajiitG,
       
    };
}
var d = Infer(model);
display(d);

There is exactly one solution:

 {"altmerT":false,
   "dumberT":false,
   "orcT":false,
   "khajiitT":true,  <--
   "altmerG":false,
   "dumberG":false,
   "orcG":true,      <--
   "khajiitG":false}

I.e. the Khajiit is telling the truth, and the Orc is guilty.
(http://hakank.org/webppl/who_killed_the_bosmer.wppl)

3 Likes

I made a solution in clpb for comparison:

:- use_module(library(clpb)).

test001 :-  true

 , SpeaksTruth = [ AltmerT, DunmerT, OrcT, KhajiitT]
 , Statements = [ AltmerS, DunmerS, OrcS, KhajiitS]
 , Guilty = [ _AltmerG, DunmerG, OrcG, KhajiitG]

 % normally we would use the implication
 % , AltmerS = ( AltmerT =< DunmerG)
 % , DunmerS = ( DunmerT =< KhajiitG)
 % , OrcS = ( OrcT =< ~ OrcG)
 % , KhajiitS = (KhajiitT =< ~ DunmerT)

 % assumption: when one doesn't say the truth, then the opposite is true
 , AltmerS = ( AltmerT =:= DunmerG)
 , DunmerS = ( DunmerT =:= KhajiitG)
 , OrcS = ( OrcT =:= ~ OrcG)
 , KhajiitS = (KhajiitT =:= ~ DunmerT)

 % all statements have to be true
 , sat( *(Statements))

 % only one says the truth
 , sat( card([1], SpeaksTruth) )
 , labeling( SpeaksTruth)

 % assumption: only one is guilty
 , sat( card( [1], Guilty) ) 
 , labeling( Guilty)

 , writeln( st-SpeaksTruth)
 , writeln( g-Guilty)
 % , writeln( stmt- Statements)

 , fail
 .

/*

(ins)?- test001.
st-[0,0,0,1]
g-[0,0,1,0]
false.

*/

To solve the ridde we have to make 2 assumptions:
(1) If we would take the statements as they are, we would have to apply the implication. But that would lead to too many results.
(2) We have to assume that only one person is guilty.

When we rely on that a task has only one solution then we use the result in a recurrent way to fix the first implementation of the solution. This may work for riddles but in practice this might not work.

So it could be cool to have an solver that can find out the assumptions.

Regards

Addendum: I did not copycat your Solution even if it looks like it. But I used your approach of unbound variables. I was convinced that I could use the implication operator but in the end it was easier to use the equality operator. But maybe there is a chance to use the implication operator when I have additional rules. This could be of interest in probabilistic solutions.

I tried something like this:

Solultion(Sol):-

Sol = [
           [0, N0, A0],
           [1, N1, A1],
           [2, N2, A2],
           [3, N3, A3],
           [4, N4, A4],
           [5, N5, A5],
           [6, N6, A6]],
member([FP, franek, _], Sol),
member([AP, albert, _], Sol),
FP<AP,
member([6, _, papuga], Sol),
member([0, _, kanarek], Sol),
member([_, franek, FA], Sol),
FA \= waz, 
member([1, _, waz], Sol),
member([_, albert, AA], Sol),
AA \= kanarek,
member([_, jarek, JA], Sol),
JA \= papuga, 
member([_, szymon, SZA], Sol),
SZA \= waz,
member([_, robert, RA], Sol),
RA \= chomik,
member([3, _, chomik], Sol),
member([RP, robert, _], Sol),
member([SP, stefan, _], Sol),
RP<SP,
member([SZP, szymon, _], Sol),
member([MP, marcin, _], Sol),
SZP<MP,
member([_, marcin, MA], Sol),
MA \= rybka,
member([4, _, rybka], Sol),
FA \= chomik,
AP<SP,
member([5, _, kot], Sol),
member([2, _, pies], Sol),
member([JP, jarek, _], Sol),
SZP<JP,
RP>AP,
AA \= pies,
FA \= pies,
member([_, stefan, SA], Sol),
SA \= kanarek,
FA \= kot,
MP>JP,
SA \= papuga,
FP<MP,
MA \= waz,
MP>AP,
FA \= rybka,
SZP>SP,
RA \= rybka,
SP>FP,
SZP>AP,
RA \= kot,
MP>RP,
FP<SZP,
FP<RP,
SP<JP,
SA \= kot,
JP>FP,
SA \= pies,
JP>RP,
FA \= papuga,
SA \= waz,
AA \= rybka,
RP<SZP,
JP>AP,
AA \= kot,
SP<MP,
AA \= papuga,
SA \= rybka,
SZA \= papuga,
SZA \= kot,
AA \= chomik,
JA \= pies,
SZA \= chomik,
MA \= pies,
SZA \= kanarek,
SZA \= pies.

but it doesnt work - can sb help to fix it?

Me too. So I tried it with a simplex solver:

:- use_module( library( simplex)).

process --> {}
   % If only one of these speaks the truth,
 , constraint( [ altmer_t, dunmer_t, orc_t, khajiit_t] = 1)

   % If only one is guilty (assumption)
 , constraint( [ altmer_g, dunmer_g, orc_g, khajiit_g] = 1)

   % The Altmer claims the Dunmer is guilty.
 , constraint( [ dunmer_g, dunmer_g_inv] =  1)
 , constraint( [ altmer_t, dunmer_g_inv] =  1)

   % The Dunmer says the Khajiit did it.
 , constraint( [ khajiit_g, khajiit_g_inv] =  1)
 , constraint( [ dunmer_t, khajiit_g_inv] =  1)

   % Orc swears he didn't kill the Bosmer.
 , constraint( [ orc_t, orc_g] =  1)

   % The Khajiit says the Dunmer is lying.
 , constraint( [ khajiit_t, dunmer_t] =  1)
 .

solve :- true

 , gen_state( START)
 , process( START, SEND)



 , maximize( [altmer_t, dunmer_t, orc_t, khajiit_t, altmer_g, dunmer_g, orc_g, khajiit_g], SEND, SMAX) 

 , forall( member( X, [altmer_t, dunmer_t, orc_t, khajiit_t, altmer_g, dunmer_g, orc_g, khajiit_g]), ( variable_value( SMAX, X, V), writeln( X - V)))

 .


Solution:

(ins)?- solve.
altmer_t-0
dunmer_t-0
orc_t-0
khajiit_t-1 % says the truth
altmer_g-0
dunmer_g-0
orc_g-1 % is guilty
khajiit_g-0
true.

But I am still trying cplint. I am very new to probabilistic solving.

Regards.