Riddle with GNU Prolog, similar to Einstein Riddle

后端 未结 1 1702
挽巷
挽巷 2020-12-04 03:34

I am a complete beginner to programming and have to create and solve a riddle in Prolog using GNU Prolog, similar to the Einstein riddle, albeit less sophisticated. I have b

相关标签:
1条回答
  • 2020-12-04 03:58

    Just be careful, and keep things uniform. Keep each thing in its own place. And, you had mangled some list codes which needed fixing. So, here you go.

    middle(M, [_,M,_]).
    right(A,B,X) :- left(B,A,X).
    left(A,B,X) :- append(_, [A,B | _], X).
    
    run :-
       X = [_,_,_],
       middle([_       ,brown,_      ],X),   /* the brown guinea pig - middle of the cage */
       member([_       ,brown,carrots],X),   /* the brown guinea pig loves to eat carrots */
       member([giggles ,_    ,salad  ],X),   /* the salad-eating guinea pig giggles */
       right( [_       ,_    ,salad  ],      /* the salad-eating guinea pig sits */
              [_       ,brown,_      ],X),   /*    to the right of the brown guinea pig */
       left(  [_       ,black,_      ],      /* the black guinea pig sleeps to the left */
              [squeaks ,_    ,_      ],X),   /*    of the squeaking guinea pig */
       member([grumbles,black,_      ],X),   /* the black guinea pig grumbles */
       member([giggles ,grey ,_      ],X),   /* the grey guinea pig giggles */
       member([_       ,EC ,cucumbers],X),   /* a guinea pig that loves to eat cucumbers */
    
       X = [[_,A,_],[_,B,_],[_,C,_]], write([A,B,C]), nl, /* write out all fur colors */
       write('the '), write(EC),
       write(' guinea pig loves to eat cucumbers'), nl. /* the answer to the question */
    

    But, some might argue, the human programmer has infused too much of his understanding here (i.e. cheated somewhat) by making the mold with three places for the three attributes that he knows guinea pigs have in this universe.

    This is not necessary though. Here's how we let the "computer" to figure that out all by itself, using kind of "extensible records" :

    attr(A, [N-V | R]):- memberchk( N-X, A), X = V, attr(A, R).
    attr(_, []).
    
    color(A, B):- attr( A, [color-B]).
    
    pigs( Pigs):-
      length( Pigs,N), 
      N rem 2 =:= 1, Middle is N div 2,    /* there _is_ a middle - list length is odd */
      nth0( Middle,Pigs,P1), attr( P1, [color-brown]), 
      member( P2, Pigs),     attr( P2, [color-brown, eats-carrots]),
      member( P3, Pigs),     attr( P3, [eats-salad, sound-giggles]),
      right( P4,P4b,Pigs),   attr( P4, [eats-salad]),   attr( P4b, [color-brown]),
      left(  P5,P5b,Pigs),   attr( P5, [color-black]),  attr( P5b, [sound-squeaks]),
      member( P6, Pigs),     attr( P6, [color-black, sound-grumbles]),
      member( P7, Pigs),     attr( P7, [color-grey,  sound-giggles]),
      member( P8, Pigs),     attr( P8, [eats-cucumbers, color-EatsCucumbers]),
      length( Furs, N),      maplist( color, Pigs, Furs),
      writeln( Furs),        writeln( EatsCucumbers),  nl, !.
    

    Testing:

    14 ?- time(( pigs(_P), maplist(writeln,_P), ! )).
    [black,brown,grey]
    black
    
    [color-black, sound-grumbles, eats-cucumbers|_G1484]
    [color-brown, eats-carrots,   sound-squeaks |_G1424]
    [eats-salad,  sound-giggles,  color-grey    |_G1463]
    /* % 287 inferences, 0.000 CPU in 0.030 seconds (0% CPU, Infinite Lips) */
    true.
    
    0 讨论(0)
提交回复
热议问题