-- demo\rosetta\Wordiff.exw
include pGUI.e
Ihandle dlg, playerset, playtime, current, remain, turn, input,
        help, quit, hframe, history, timer
atom t0, t1, t=0

constant title = "Wordiff game",
     help_text = """
Allows single or multi-player modes.
Enter eg "Pete" to play every round yourself,
"Computer" for the computer to play itself,
"Pete,Computer" (or vice versa) to play against the computer,
"Pete,Sue" for a standard two-payer game, or
"Pete,Computer,Sue,Computer" for auto-plays between each human.
Words must be 3 letters or more, and present in the dictionary,
and not already used. You must key return (not tab) to finish
entering your move. The winner is the fastest average time, if
the timer is running (/non-zero), otherwise play continues
until player elimination leaves one (or less) remaining.
NB: Pressing tab or clicking on help will restart or otherwise
mess up the gameplay.
"""
function help_cb(Ihandln /*ih*/)
    IupMessage(title,help_text)
    IupSetFocus(dlg)
    return IUP_DEFAULT
end function

function over2(string word) return length(word)>2 end function
function less5(string word) return length(word)<5 end function

sequence words = filter(unix_dict(),over2),
         valid = {},
         used = {}

string word
integer lw

sequence players, eliminated, times, averages
integer player

function levenshtein1(string w)
    bool res = false
    integer l = length(w)
    if not find(w,used) and abs(l-lw)<=1 then
        sequence costs = tagset(l+1,0)
        for i=1 to lw do
            costs[1] = i
            integer newcost = i-1, pj = i
            for j=1 to l do
                integer cj = costs[j+1],
                        ne = word[i]!=w[j],
                        nc = newcost+ne
                pj = min({pj+1, cj+1, nc})
                costs[j+1] = pj
                newcost = cj
            end for
        end for
        res = costs[$-1]==1
    end if
    return res
end function

procedure game_over()
    IupSetAttribute(history,"APPENDITEM","GAME OVER:")
    if length(valid) then
        string valids = "You could have had "&join(valid,", ")
        IupSetAttribute(history,"APPENDITEM",valids)
    end if
    string winner = "nobody"
    atom best = -1
    for i=1 to length(players) do
        string player = players[i], msg
        if eliminated[i] then
            msg = ": eliminated"
        else
            atom average = averages[i]
            if average=-1 then
                msg = ": no times"
            else
                msg = sprintf(": %.3f",average)
                if best=-1 or average<best then
                    winner = player
                    best = average
                end if
            end if
        end if
        IupSetAttribute(history,"APPENDITEM",player&msg)
    end for
    IupSetAttribute(history,"APPENDITEM","And the winner is: "&winner)
    IupSetInt(history,"TOPITEM",IupGetInt(history,"COUNT"))
    IupSetInt(timer,"RUN",false)
end procedure

procedure score(string move)
    times[player] = append(times[player],time()-t1)
    averages[player] = sum(times[player])/length(times[player])
    used = append(used,move)
    word = move
    lw = length(word)
    valid = filter(words,levenshtein1)
    IupSetStrAttribute(current,"TITLE","Current word: "&word)
end procedure

procedure advance_player()
    while true do
        player = mod(player,length(players))+1
        if not eliminated[player] then exit end if
    end while
    IupSetStrAttribute(turn,"TITLE",players[player]&"'s turn:")
    IupRefreshChildren(turn)
    IupSetStrAttribute(input,"VALUE",word)
    t1 = time()
end procedure

procedure autoplay()
    while true do
        if length(valid)=0 then
            IupSetAttribute(history,"APPENDITEM","no more moves possible")
            game_over()
            exit
        end if
        if proper(players[player])!="Computer" then exit end if
        string move = valid[rand(length(valid))]
        IupSetStrAttribute(history,"APPENDITEM","%s's move: %s\n",
                           {players[player],move})
        IupSetInt(history,"TOPITEM",IupGetInt(history,"COUNT"))
        score(move)
        advance_player()
    end while
end procedure

procedure new_game(bool bStart=true)
    bool bActive = length(players)!=0
    IupSetInt(turn,"ACTIVE",bActive)
    IupSetInt(input,"ACTIVE",bActive)
    if bActive and bStart then
        sequence w34 = filter(words,less5)
        while true do
            integer r = rand(length(w34))
            word = w34[r]
            lw = length(word)
            used = {word}
            valid = filter(words,levenshtein1)
            if length(valid)!=0 then exit end if
            w34[r..r] = {}
        end while
        IupSetStrAttribute(current,"TITLE","Current word: "&word)
        IupSetStrAttribute(turn,"TITLE",players[player]&"'s turn:")
        IupRefreshChildren(turn)
        IupSetStrAttribute(input,"VALUE",word)
        IupSetAttribute(history,"REMOVEITEM","ALL")
        IupSetAttribute(history,"APPENDITEM","Initial word: "&word)
        IupSetInt(history,"TOPITEM",IupGetInt(history,"COUNT"))
        integer l = length(players)
        eliminated = repeat(false,l)
        times = repeat({},l)
        averages = repeat(-1,l)
        t0 = time()
        t1 = time()
        IupSetInt(timer,"RUN",t!=0)
        autoplay()
    end if
end procedure

function players_cb(Ihandln /*playerset*/)
    players = split(IupGetAttribute(playerset,"VALUE"),",")
    player = 1
    new_game(false)
    return IUP_DEFAULT
end function

function playtime_cb(Ihandle /*playtime*/)
    t = IupGetInt(playtime, "VALUE")
    if t then
        IupSetInt(remain,"VISIBLE",true)
        IupSetStrAttribute(remain,"TITLE","Remaining: %.1fs",{t})
    else
        IupSetInt(remain,"VISIBLE",false)
    end if
    IupRefreshChildren(remain)
    return IUP_DEFAULT
end function

function focus_cb(Ihandle /*input*/)
    new_game(true)
    return IUP_DEFAULT
end function

procedure verify_move()
    string move = IupGetAttribute(input,"VALUE"),
           okstr = "ok"
    bool ok = not find(move,used)
    if not ok then
        okstr = "already used"
    else
        ok = find(move,words)
        if not ok then
            okstr = "not in dictionary"
        else
            ok = find(move,valid)
            if not ok then
                okstr = "more than one change"
            else
                used = append(used,move)
            end if
        end if
    end if
    if not ok then
        okstr &= ", player eliminated"
    end if
    IupSetStrAttribute(history,"APPENDITEM","%s's move: %s %s\n",
                       {players[player],move,okstr})
    IupSetInt(history,"TOPITEM",IupGetInt(history,"COUNT"))
    if not ok then
        eliminated[player] = true
        if length(players)-sum(eliminated)<=1 then
            game_over()
            return
        end if
    else
        score(move)
    end if
    advance_player()
    autoplay()
end procedure

function timer_cb(Ihandle /*timer*/)
    atom e = time()-t0
    if e>=t then
        IupSetStrAttribute(remain,"TITLE","Remaining: 0s")
        IupSetInt(turn,"ACTIVE",false)
        IupSetInt(input,"ACTIVE",false)
        game_over()
    else
        IupSetStrAttribute(remain,"TITLE","Remaining: %.1fs",{t-e})
    end if
    return IUP_DEFAULT
end function

function quit_cb(Ihandle /*ih*/)
    return IUP_CLOSE
end function

function key_cb(Ihandle /*dlg*/, atom c)
    if c=K_ESC then return IUP_CLOSE
    elsif c=K_CR then
        Ihandln focus = IupGetFocus()
        if focus=playerset then
            IupSetFocus(playtime)
        elsif focus=playtime then
            IupSetFocus(input)
            new_game()
        elsif focus=input then
            verify_move()
        end if
    elsif c=K_F1 then return help_cb(NULL)
    elsif c=K_cC then
        integer n = IupGetInt(history,"COUNT")
        sequence hist = repeat(0,n)
        for i=1 to n do
            hist[i] = IupGetAttributeId(history,"",i)
        end for
        hist = join(hist,"\n")
        Ihandln clip = IupClipboard()
        IupSetAttribute(clip,"TEXT",hist)
        clip = IupDestroy(clip)
    end if
    return IUP_CONTINUE
end function

IupOpen()
playerset = IupText(`EXPAND=HORIZONTAL`)
playtime = IupText(`SPIN=Yes, SPINMIN=0, RASTERSIZE=48x`)
IupSetCallback({playerset,playtime},"KILLFOCUS_CB",Icallback("players_cb"))
IupSetCallback(playtime,"VALUECHANGED_CB",Icallback("playtime_cb"))
turn = IupLabel("turn","ACTIVE=NO")
input = IupText("EXPAND=HORIZONTAL, ACTIVE=NO")
IupSetCallback(input,"GETFOCUS_CB",Icallback("focus_cb"))
current = IupLabel("Current word:","EXPAND=HORIZONTAL")
remain = IupLabel("Remaining time:0s","VISIBLE=NO")
history = IupList("VISIBLELINES=10, EXPAND=YES, CANFOCUS=NO")
hframe = IupFrame(history,"TITLE=History, PADDING=5x4")
help = IupButton("Help (F1)",Icallback("help_cb"),"PADDING=5x4")
quit = IupButton("Close", Icallback("quit_cb"))
timer = IupTimer(Icallback("timer_cb"),100,false)
sequence buttons = {IupFill(),help,IupFill(),quit,IupFill()}
constant acp = "ALIGNMENT=ACENTER, PADDING=5"
Ihandle settings = IupHbox({IupLabel("Contestant name(s)"),
                            playerset,
                            IupLabel("Timer (seconds)"),
                            playtime},acp),
        currbox = IupHbox({current,remain},acp),
        numbox = IupHbox({turn,input},acp),
        btnbox = IupHbox(buttons,"PADDING=40, NORMALIZESIZE=BOTH"),
        vbox = IupVbox({settings,
                        currbox,
                        numbox, hframe, btnbox}, "GAP=5,MARGIN=5x5")
dlg = IupDialog(vbox, `TITLE="%s", SIZE=500x220`, {title})
IupSetCallback(dlg, "K_ANY", Icallback("key_cb"))
IupShow(dlg)
if platform()!=JS then
    IupMainLoop()
    IupClose()
end if


 		1		2		3		4		5
colors		Blue		Blue		Blue		Blue		Blue
colors		Green		Green		Green		Green		Green
colors		Red		Red		Red		Red		Red
colors		White		White		White		White		White
colors		Yellow		Yellow		Yellow		Yellow		Yellow
nationality	Dane		Dane		Dane		Dane		Dane
nationality	English		English		English		English		English
nationality	German		German		German		German		German
nationality	Norwegian	Norwegian	Norwegian	Norwegian	Norwegian
nationality	Swede		Swede		Swede		Swede		Swede
beverage	Beer		Beer		Beer		Beer		Beer
beverage	Coffee		Coffee		Coffee		Coffee		Coffee
beverage	Milk		Milk		Milk		Milk		Milk
beverage	Tea		Tea		Tea		Tea		Tea
beverage	Water		Water		Water		Water		Water
animal		Birds		Birds		Birds		Birds		Birds
animal		Cats		Cats		Cats		Cats		Cats
animal		Dog		Dog		Dog		Dog		Dog
animal		Horse		Horse		Horse		Horse		Horse
animal		Zebra		Zebra		Zebra		Zebra		Zebra
smoke		Blend		Blend		Blend		Blend		Blend
smoke		Blue Master	Blue Master	Blue Master	Blue Master	Blue Master
smoke		Dunhill		Dunhill		Dunhill		Dunhill		Dunhill
smoke		Pall Mall	Pall Mall	Pall Mall	Pall Mall	Pall Mall
smoke		Prince		Prince		Prince		Prince		Prince


:- module zebra.
:- interface.

:- import_module io.

:- pred main(io, io).
:- mode main(di, uo) is cc_multi.   % or det for all-solutions

:- implementation.

:- import_module list.
:- import_module solutions.

% perm

:- pred my_perm(list(T), list(T)).
:- mode my_perm(in, out) is multi.

my_perm([], []).
my_perm([X | Xs], Perm) :-
    my_perm(Xs, PermXs),
    my_insert(X, PermXs, Perm).

:- pred my_insert(T, list(T), list(T)).
:- mode my_insert(in, in, out) is multi.

my_insert(X, [], [X]).
my_insert(X, [Y | Ys], Zs) :-
    (
        Zs = [X, Y | Ys]
    ;
        my_insert(X, Ys, Zs0),
        Zs = [Y | Zs0]
    ).

% The puzzle

:- type person
  --->    english
  ;       spanish
  ;       ukrainian
  ;       norwegian
  ;       japanese.

:- pred left_of(list(T), T, T).
:- mode left_of(in, in, in) is semidet.

left_of([A, B | _], A, B).
left_of([_ | List], A, B) :- left_of(List, A, B).

:- pred next_to(list(T), T, T).
:- mode next_to(in, in, in) is semidet.

next_to(List, A, B) :-
    ( left_of(List, A, B)
    ; left_of(List, B, A)
    ).

:- pred puzzle({list(person), list(person), list(person), list(person),
    list(person)}).
:- mode puzzle(out) is nondet.

puzzle({Houses, Colours, Pets, Drinks, Smokes}) :-
    % 10. The Norwegian lives in the first house.
    First = norwegian,
    perm([english, spanish, ukrainian, japanese],
        [Second, Third, Fourth, Fifth]),

    % 2. The Englishman lives in the red house.
    Red = english,
    perm([spanish, ukrainian, norwegian, japanese],
        [Green, Ivory, Yellow, Blue]),

    % 10. The Norwegian lives in the first house.
    % 15. The Norwegian lives next to the blue house.
    Second = Blue,

    % 6. The green house is immediately to the right of the ivory house.
    left_of(Houses, Ivory, Green),

    % 3. The Spaniard owns the dog.
    Dog = spanish,
    perm([english, ukrainian, norwegian, japanese],
        [Snails, Fox, Horse, Zebra]),

    % 4. Coffee is drunk in the green house.
    Green = Coffee,

    % 5. The Ukrainian drinks tea.
    Tea = ukrainian,

    % 9. Milk is drunk in the middle house.
    Milk = Third,

    perm([english, spanish, norwegian, japanese],
        [Coffee, Milk, Juice, Water]),

    % 7. The Old Gold smoker owns snails.
    Snails = OldGold,

    % 8. Kools are smoked in the yellow house.
    Kools = Yellow,

    % 13. The Lucky Strike smoker drinks orange juice.
    LuckyStrike = Juice,

    % 14. The Japanese smokes Parliaments.
    Parliament = japanese,

    perm([english, spanish, ukrainian, norwegian],
        [OldGold, Kools, Chesterfield, LuckyStrike]),

    % 11. The man who smokes Chesterfields lives in the house
    % next to the man with the fox.
    next_to(Houses, Chesterfield, Fox),

    % 12. Kools are smoked in the house next to the house
    % where the horse is kept.
    next_to(Houses, Kools, Horse),

    Houses = [First, Second, Third, Fourth, Fifth],
    Colours = [Red, Green, Ivory, Yellow, Blue],
    Pets = [Dog, Snails, Fox, Horse, Zebra],
    Drinks = [Coffee, Tea, Milk, Juice, Water],
    Smokes = [OldGold, Kools, Chesterfield, LuckyStrike, Parliament].

% Printing a solution

:- pred write_solution({list(person), list(person), list(person),
    list(person), list(person)}::in, io::di, io::uo) is det.

write_solution({Houses, Colours, Pets, Drinks, Smokes}, !IO) :-
    write_string("--------\n", !IO),
    write_assignments(["1st", "2nd", "3rd", "4th", "5th"],
        Houses, !IO),
    write_assignments(["red", "green", "ivory", "yellow", "blue"],
        Colours, !IO),
    write_assignments(["dog", "snails", "fox", "horse", "zebra"],
        Pets, !IO),
    write_assignments(["coffee", "tea", "milk", "juice", "water"],
        Drinks, !IO),
    write_assignments(["oldgold", "kools", "chesterfield",
        "luckystrike", "parliament"], Smokes, !IO).

:- pred write_assignments(list(string)::in, list(person)::in,
    io::di, io::uo) is det.

write_assignments(Labels, Persons, !IO) :-
    foldl_corresponding(write_assignment, Labels, Persons, !IO),
    nl(!IO).

:- pred write_assignment(string::in, person::in, io::di, io::uo) is det.

write_assignment(Label, Person, !IO) :-
    write_string(Label, !IO),
    write_string(" - ", !IO),
    write(Person, !IO),
    write_string("\n", !IO).

% main

main(!IO) :-
    % Print all solutions.
    /*
    solutions(puzzle, Solutions),
    foldl(write_solution, Solutions, !IO).
    */

    % Print solutions as they are found.
    /*
    unsorted_aggregate(puzzle, write_solution, !IO).
    */

    % Print one solution.
    ( if puzzle(Solution) then
        write_solution(Solution, !IO)
    else
        write_string("No solution found.\n", !IO)
    ).


use strict;
use warnings;
use feature 'say';
use List::Util 'min';

my %cache;
sub leven {
    my ($s, $t) = @_;
    return length($t) if $s eq '';
    return length($s) if $t eq '';
    $cache{$s}{$t} //=
      do {
        my ($s1, $t1) = (substr($s, 1), substr($t, 1));
        (substr($s, 0, 1) eq substr($t, 0, 1))
          ? leven($s1, $t1)
          : 1 + min(
                    leven($s1, $t1),
                    leven($s,  $t1),
                    leven($s1, $t ),
            );
      };
}

print "What is your name?"; my $name = <STDIN>;
$name = 'Number 6';
say "What is your quest? Never mind that, I will call you '$name'";
say 'Hey! I am not a number, I am a free man!';

my @starters = grep { length() < 6 } my @words = grep { /.{2,}/ } split "\n", `cat unixdict.txt`;

my(%used,@possibles,$guess);
my $rounds = 0;
my $word = say $starters[ rand $#starters ];

while () {
    say "Word in play: $word";
    $used{$word} = 1;
    @possibles = ();
    for my $w (@words) {
        next if abs(length($word) - length($w)) > 1;
        push @possibles, $w if leven($word, $w) == 1 and ! defined $used{$w};
    }
    print "Your word? "; $guess = <STDIN>;  chomp $guess;
    last unless grep { $guess eq $_ } @possibles;
    $rounds++;
    $word = $guess;
}

my $already = defined $used{$guess} ? " '$guess' was already played but" : '';

if (@possibles) { say "\nSorry $name,${already} one of <@possibles> would have continued the game." }
else            { say "\nGood job $name,${already} there were no possible words to play."                }
say "You made it through $rounds rounds.";


%Solve Zebra Puzzle. Nigel Galloway, August 27th., 2019
include "alldifferent.mzn";
enum N={English,Swedish,Danish,German,Norwegian};
enum I={Tea,Coffee,Milk,Beer,Water};
enum G={Dog,Birds,Cats,Horse,Zebra};
enum E={Red,Green,White,Blue,Yellow};
enum L={PallMall,Dunhill,BlueMaster,Prince,Blend};
array[1..5] of var N: Nz; constraint alldifferent(Nz); constraint Nz[1]=Norwegian;                   %The Norwegian lives in the first house.
array[1..5] of var I: Iz; constraint alldifferent(Iz); constraint Iz[3]=Milk;                        %In the middle house they drink milk.
array[1..5] of var G: Gz; constraint alldifferent(Gz);
array[1..5] of var E: Ez; constraint alldifferent(Ez);
array[1..5] of var L: Lz; constraint alldifferent(Lz);
constraint exists(n in 1..5)(Nz[n]=English /\ Ez[n]=Red);                                            %The English man lives in the red house
constraint exists(n in 1..5)(Nz[n]=Swedish /\ Gz[n]=Dog);                                            %The Swede has a dog.
constraint exists(n in 1..5)(Nz[n]=Danish  /\ Iz[n]=Tea);                                            %The Dane drinks tea.
constraint exists(n in 1..4)(Ez[n]=Green /\ Ez[n+1]=White);                                          %The green house is immediately to the left of the white house.
constraint exists(n in 1..5)(Ez[n]=Green /\ Iz[n]=Coffee);                                           %They drink coffee in the green house.
constraint exists(n in 1..5)(Lz[n]=PallMall /\ Gz[n]=Birds);                                         %The man who smokes Pall Mall has birds
constraint exists(n in 1..5)(Ez[n]=Yellow /\ Lz[n]=Dunhill);                                         %In the yellow house they smoke Dunhill.
constraint exists(n in 1..4)((Lz[n]=Blend /\ Gz[n+1]=Cats) \/ (Lz[n+1]=Blend /\ Gz[n]=Cats));        %The man who smokes Blend lives in the house next to the house with cats.
constraint exists(n in 1..4)((Gz[n]=Horse /\ Lz[n+1]=Dunhill) \/ (Gz[n+1]=Horse /\ Lz[n]=Dunhill));  %In a house next to the house where they have a horse, they smoke Dunhill.
constraint exists(n in 1..5)(Lz[n]=BlueMaster /\ Iz[n]=Beer);                                        %The man who smokes Blue Master drinks beer.
constraint exists(n in 1..5)(Nz[n]=German /\ Lz[n]=Prince);                                          %The German smokes Prince.
constraint exists(n in 1..4)((Nz[n]=Norwegian /\ Ez[n+1]=Blue) \/ (Nz[n+1]=Norwegian /\ Ez[n]=Blue));%The Norwegian lives next to the blue house.
constraint exists(n in 1..4)((Lz[n]=Blend /\ Iz[n+1]=Water) \/ (Lz[n+1]=Blend /\ Iz[n]=Water));      %They drink water in a house next to the house where they smoke Blend.
var 1..5: n;
constraint Gz[n]=Zebra;
solve satisfy;
output ["The "++show(Nz[n])++" owns the zebra"++"\n\n"++show(Nz)++"\n"++show(Iz)++"\n"++show(Gz)++"\n"++show(Ez)++"\n"++show(Lz)++"\n"];


remove is op x xs {filter (not (x =)) xs}

append_map is transformer func op seq { \
  reduce (op x xs { (func x) link xs}) (seq append []) }

permutations is op seq { \
  if empty seq then [[]] else \
    (append_map \
      (op head {each (op tail {head hitch tail}) \
                     (permutations (remove head seq))}) \
      seq) \
  endif}

f is find
tokenize is op str{string_split ' ' str}
mk is tr pred op str {filter pred permutations tokenize str}
eq is op x xs y ys{f x xs = f y ys}
adj is op x xs y ys{1 = abs(f x xs - f y ys)}

run is  { \
  men := mk (op xs {0 = f 'norwegian' xs}) \
    'danish english german norwegian swedish'; \
  colors := mk (op xs {1 = ((f 'white' xs) - (f 'green' xs))}) \
    'blue green red white yellow'; \
  drinks := mk (op xs {2 = f 'milk' xs}) 'beer coffee milk tea water'; \
  pets := mk (op xs {l}) 'birds cats dog horse zebra'; \
  smokes := mk (op xs {l}) 'blend blue-master dunhill pall-mall prince'; \
  for m with men do \
    for c with colors do \
      if  (eq 'english' m 'red' c) and \
          (adj 'norwegian' m 'blue' c) then \
        for d with drinks do \
          if  (eq 'danish' m 'tea' d) and \
              (eq 'coffee' d 'green' c) then \
            for s with smokes do \
              if  (eq 'yellow' c 'dunhill' s) and \
                  (eq 'blue-master' s 'beer' d) and \
                  (eq 'german' m 'prince' s) then \
                for p with pets do \
                  if  (eq 'birds' p 'pall-mall' s) and \
                      (eq 'swedish' m 'dog' p) and \
                      (adj 'blend' s 'cats' p) and \
                      (adj 'horse' p 'dunhill' s) then \
                    write (0 blend (p m c d s)) \
                  endif \
                endfor \
              endif \
            endfor \
          endif \
        endfor \
      endif \
    endfor \
  endfor }

abs(time - (run; time))


# -*- coding: utf-8 -*-

from typing import List, Tuple, Dict, Set
from itertools import cycle, islice
from collections import Counter
import re
import random
import urllib

dict_fname = 'unixdict.txt'
dict_url1 = 'http://wiki.puzzlers.org/pub/wordlists/unixdict.txt'    # ~25K words
dict_url2 = 'https://raw.githubusercontent.com/dwyl/english-words/master/words.txt'  # ~470K words

word_regexp = re.compile(r'^[a-z]{3,}$')    # reduce dict words to those of three or more a-z characters.

def load_dictionary(fname: str=dict_fname) -> Set[str]:
    "Return appropriate words from a dictionary file"
    with open(fname) as f:
        return {lcase for lcase in (word.strip().lower() for word in f)
                if word_regexp.match(lcase)}

def load_web_dictionary(url: str) -> Set[str]:
    "Return appropriate words from a dictionary web page"
    words = urllib.request.urlopen(url).read().decode().strip().lower().split()
    return {word for word in words if word_regexp.match(word)}

def get_players() -> List[str]:
    "Return inputted ordered list of contestant names."
    names = input('Space separated list of contestants: ')
    return [n.capitalize() for n in names.strip().split()]

def is_wordiff(wordiffs: List[str], word: str, dic: Set[str], comment=True) -> bool:
    "Is word a valid wordiff from wordiffs[-1] ?"
    if word not in dic:
        if comment:
            print('That word is not in my dictionary')
        return False
    if word in wordiffs:
        if comment:
            print('That word was already used.')
        return False
    if len(word) < len(wordiffs[-1]):
        return is_wordiff_removal(word, wordiffs[-1], comment)
    elif len(word) > len(wordiffs[-1]):
        return is_wordiff_insertion(word, wordiffs[-1], comment)

    return is_wordiff_change(word, wordiffs[-1], comment)

def is_wordiff_removal(word: str, prev: str, comment=True) -> bool:
    "Is word derived from prev by removing one letter?"
    ...
    ans = word in {prev[:i] + prev[i+1:] for i in range(len(prev))}
    if not ans:
        if comment:
            print('Word is not derived from previous by removal of one letter.')
    return ans

def is_wordiff_insertion(word: str, prev: str, comment=True) -> bool:
    "Is word derived from prev by adding one letter?"
    diff = Counter(word) - Counter(prev)
    diffcount = sum(diff.values())
    if diffcount != 1:
        if comment:
            print('More than one character insertion difference.')
        return False

    insert = list(diff.keys())[0]
    ans =  word in {prev[:i] + insert + prev[i:] for i in range(len(prev) + 1)}
    if not ans:
        if comment:
            print('Word is not derived from previous by insertion of one letter.')
    return ans

def is_wordiff_change(word: str, prev: str, comment=True) -> bool:
    "Is word derived from prev by changing exactly one letter?"
    ...
    diffcount = sum(w != p for w, p in zip(word, prev))
    if diffcount != 1:
        if comment:
            print('More or less than exactly one character changed.')
        return False
    return True

def could_have_got(wordiffs: List[str], dic: Set[str]):
    return (word for word in (dic - set(wordiffs))
            if is_wordiff(wordiffs, word, dic, comment=False))

if __name__ == '__main__':
    dic = load_web_dictionary(dict_url2)
    dic_3_4 = [word for word in dic if len(word) in {3, 4}]
    start = random.choice(dic_3_4)
    wordiffs = [start]
    players = get_players()
    for name in cycle(players):
        word = input(f"{name}: Input a wordiff from {wordiffs[-1]!r}: ").strip()
        if is_wordiff(wordiffs, word, dic):
            wordiffs.append(word)
        else:
            print(f'YOU HAVE LOST {name}!')
            print("Could have used:",
                  ', '.join(islice(could_have_got(wordiffs, dic), 10)), '...')
            break


import algorithm, strformat, sequtils

type

  Color {.pure.} = enum Blue, Green, Red, White, Yellow
  Person {.pure.} = enum Dane, English, German, Norwegian, Swede
  Pet {.pure.} = enum Birds, Cats, Dog, Horse, Zebra
  Drink {.pure.} = enum Beer, Coffee, Milk, Tea, Water
  Cigarettes {.pure.} = enum Blend, BlueMaster = "Blue Master",
                             Dunhill, PallMall = "Pall Mall", Prince

  House = tuple
    color: Color
    person: Person
    pet: Pet
    drink: Drink
    cigarettes: Cigarettes

  Houses = array[5, House]

iterator permutations[T](): array[5, T] =
  ## Yield the successive permutations of values of type T.
  var term = [T(0), T(1), T(2), T(3), T(4)]
  yield term
  while term.nextPermutation():
    yield term

proc findSolutions(): seq[Houses] =
  ## Return all the solutions.

  for colors in permutations[Color]():
    if colors.find(White) != colors.find(Green) + 1: continue                   #  5
    for persons in permutations[Person]():
      if persons[0] != Norwegian: continue                                      # 10
      if colors.find(Red) != persons.find(English): continue                    #  2
      if abs(persons.find(Norwegian) - colors.find(Blue)) != 1: continue        # 15
      for pets in permutations[Pet]():
        if persons.find(Swede) != pets.find(Dog): continue                      #  3
        for drinks in permutations[Drink]():
          if drinks[2] != Milk: continue                                        #  9
          if persons.find(Dane) != drinks.find(Tea): continue                   #  4
          if colors.find(Green) != drinks.find(Coffee): continue                #  6
          for cigarettes in permutations[Cigarettes]():
            if cigarettes.find(PallMall) != pets.find(Birds): continue          #  7
            if cigarettes.find(Dunhill) != colors.find(Yellow): continue        #  8
            if cigarettes.find(BlueMaster) != drinks.find(Beer): continue       # 13
            if cigarettes.find(Prince) != persons.find(German): continue        # 14
            if abs(cigarettes.find(Blend) - pets.find(Cats)) != 1: continue     # 11
            if abs(cigarettes.find(Dunhill) - pets.find(Horse)) != 1: continue  # 12
            if abs(cigarettes.find(Blend) - drinks.find(Water)) != 1: continue  # 16
            var houses: Houses
            for i in 0..4:
              houses[i] = (colors[i], persons[i], pets[i], drinks[i], cigarettes[i])
            result.add houses

let solutions = findSolutions()
echo "Number of solutions: ", solutions.len
let sol = solutions[0]
echo()

echo "Number  Color    Person      Pet     Drink    Cigarettes"
echo "——————  ——————   —————————   —————   ——————   ———————————"
for i in 0..4:
  echo &"{i + 1:3}     {sol[i].color:6}   {sol[i].person:9}   ",
       &"{sol[i].pet:5}   {sol[i].drink:6}   {sol[i].cigarettes: 11}"

let owner = sol.filterIt(it.pet == Zebra)[0].person
echo &"\nThe {owner} owns the zebra."


perm(arr) = {
n=#arr;i=n-1;
while(i > -1,if (arr[i] < arr[i+1],break);i--);
j=n;
while(arr[j]<= arr[i],j -=1);
tmp = arr[i] ;arr[i]=arr[j];arr[j]=tmp;
i +=1; j = n;
while(i < j ,tmp = arr[i] ;arr[i]=arr[j];arr[j]=tmp;
i +=1; j -=1);
return(arr);
}
perms(arr)={
n=#arr;
result = List();
listput(result,arr);
for(i=1,n!-1,arr=perm(arr);listput(result,arr));
return(result);
}

adj(x,xs,y,ys)={
  abs(select(z->z==x,xs,1)[1] - select(z->z==y,ys,1)[1])==1;
}
eq(x,xs,y,ys)={
   select(z->z==x,xs,1) == select(z->z==y,ys,1);
}

colors =Vec(perms( ["Blue", "Green", "Red", "White", "Yellow"]));;
drinks  =Vec(perms( ["Beer", "Coffee", "Milk", "Tea", "Water"]));;
nations =Vec(perms( ["Denmark", "England", "Germany", "Norway", "Sweden"]));;
smokes  =Vec(perms( ["Blend", "BlueMaster", "Dunhill", "PallMall", "Prince"]));;
pets =Vec(perms( ["Birds", "Cats", "Dog", "Horse", "Zebra"]));;;
colors= select(x->select(z->z=="White",x,1)[1] - select(z->z=="Green",x,1)[1]==1,colors);
drinks=select(x->x[3]=="Milk",drinks);
nations=select(x->x[1]=="Norway",nations);

for(n=1,#nations,for(c=1,#colors,\
if(eq("Red",colors[c],"England",nations[n]) && adj("Norway",nations[n],"Blue",colors[c]),\
for(d=1,#drinks,\
if(eq("Denmark",nations[n],"Tea",drinks[d])&& eq("Coffee",drinks[d],"Green",colors[c]),\
for(s=1,#smokes,\
if(eq("Yellow",colors[c],"Dunhill",smokes[s]) &&\
eq("BlueMaster",smokes[s],"Beer",drinks[d]) &&\
eq("Germany",nations[n],"Prince",smokes[s]),\
for(p=1,#pets,\
if(eq("Birds",pets[p],"PallMall",smokes[s]) &&\
eq("Sweden",nations[n],"Dog",pets[p]) &&\
adj("Blend",smokes[s],"Cats",pets[p]) &&\
adj("Horse",pets[p],"Dunhill",smokes[s]),\
print("Zebra is owned by ",nations[n][select(z->z=="Zebra",pets[p],1)[1]]);print();\
for(i=1,5,printf("House:%s %6s %10s %10s %10s %10s\n",i,colors[c][i],nations[n][i],pets[p][i],drinks[d][i],smokes[s][i]));\
)))))))));


my @words = 'unixdict.txt'.IO.slurp.lc.words.grep(*.chars > 2);

my @small = @words.grep(*.chars < 6);

use Text::Levenshtein;

my ($rounds, $word, $guess, @used, @possibles) = 0;

loop {
    my $lev;
    $word = @small.pick;
    hyper for @words  -> $this {
        next if ($word.chars - $this.chars).abs > 1;
        last if ($lev = distance($word, $this)[0]) == 1;
    }
    last if $lev;
}

my $name = ',';

#[[### Entirely unnecessary and unuseful "chatty repartee" but is required by the task

run 'clear';
$name = prompt "Hello player one, what is your name? ";
say "Cool. I'm going to call you Gomer.";
$name = ' Gomer,';
sleep 1;
say "\nPlayer two, what is your name?\nOh wait, this isn't a \"specified number of players\" game...";
sleep 1;
say "Nevermind.\n";

################################################################################]]

loop {
    say "Word in play: $word";
    push @used, $word;
    @possibles = @words.hyper.map: -> $this {
        next if ($word.chars - $this.chars).abs > 1;
        $this if distance($word, $this)[0] == 1 and $this ∉ @used;
    }
    $guess = prompt "your word? ";
    last unless $guess ∈ @possibles;
    ++$rounds;
    say qww<Ok! Woot! 'Way to go!' Nice! 👍 😀>.pick ~ "\n";
    $word = $guess;
}

my $already = ($guess ∈ @used) ?? " $guess was already played but" !! '';

if @possibles {
    say "\nOops. Sorry{$name}{$already} one of [{@possibles}] would have continued the game."
} else {
    say "\nGood job{$name}{$already} there were no possible words to play."
}
say "You made it through $rounds rounds.";


/*REXX program acts as a host and allows two or more people to play the   WORDIFF  game.*/
signal on halt                                   /*allow the user(s) to halt the game.  */
parse arg iFID seed .                            /*obtain optional arguments from the CL*/
if iFID=='' | iFID=="," then iFID='unixdict.txt' /*Not specified?  Then use the default.*/
if datatype(seed, 'W')  then call random ,,seed  /*If      "         "   "   "    seed. */
call read
call IDs
first= random(1, min(100000, starters) )         /*get a random start word for the game.*/
list= $$$.first
say;                say eye  "OK, let's play the  WORDIFF  game.";   say;   say
         do round=1
                    do player=1  for players
                    call show;   ou= o;   upper ou
                    call CBLF  word(names, player)
                    end   /*players*/
         end              /*round*/

halt: say;  say;  say eye 'The  WORDIFF  game has been halted.'
done: exit 0                                     /*stick a fork in it,  we're all done. */
quit: say;  say;  say eye 'The  WORDDIF  game is quitting.';   signal done
/*──────────────────────────────────────────────────────────────────────────────────────*/
isMix: return datatype(arg(1), 'M')              /*return unity if arg has mixed letters*/
ser:   say;   say eye '***error*** ' arg(1).;   say;    return  /*issue error message.  */
last:  parse arg y;      return word(y, words(y) )              /*get last word in list.*/
over:  call ser 'word ' _ x _ arg(1);  say eye 'game over,' you; signal done /*game over*/
show:  o= last(list);   say;  call what;  say;   L= length(o);    return
verE:  m= 0;  do v=1  for L; m= m + (substr(ou,v,1)==substr(xu,v,1)); end;   return m==L-1
verL:  do v=1  for L;  if space(overlay(' ', ou, v), 0)==xu  then return 1; end;  return 0
verG:  do v=1  for w;  if space(overlay(' ', xu, v), 0)==ou  then return 1; end;  return 0
what:  say eye 'The current word in play is: '   _   o   _;       return
/*──────────────────────────────────────────────────────────────────────────────────────*/
CBLF:  parse arg you                             /*ask carbon-based life form for a word*/
          do getword=0  by 0  until x\==''
          say eye "What's your word to be played, " you'?'
          parse pull x;  x= space(x);   #= words(x);  if #==0  then iterate;  w= length(x)
          if #>1  then do;  call ser 'too many words given: '   x
                            x=;  iterate getword
                       end
          if \isMix(x)  then do;  call ser 'the name'   _  x  _  " isn't alphabetic"
                                  x=;   iterate getword
                             end
          end   /*getword*/

       if wordpos(x, list)>0  then call over " has already been used"
       xu= x;  upper xu                          /*obtain an uppercase version of word. */
       if \@.xu  then call over  " doesn't exist in the dictionary: " iFID
       if length(x) <3            then call over  " must be at least three letters long."
       if w <L  then  if \verL()  then call over  " isn't a legal letter deletion."
       if w==L  then  if \verE()  then call over  " isn't a legal letter substitution."
       if w >L  then  if \verG()  then call over  " isn't a legal letter addition."
       list= list  x                             /*add word to the list of words used.  */
       return
/*──────────────────────────────────────────────────────────────────────────────────────*/
IDs:   ?= "Enter the names of the people that'll be playing the WORDIFF game   (or Quit):"
       names=                                    /*start with a clean slate (of names). */
          do getIDs=0  by 0  until words(names)>1
          say;  say eye ?
          parse pull ids;  ids= space( translate(ids, , ',') )      /*elide any commas. */
          if ids==''  then iterate;  q= ids;  upper q               /*use uppercase QUIT*/
          if abbrev('QUIT', q, 1)  then signal quit
            do j=1  for words(ids);    x= word(ids, j)
            if \isMix(x)  then do;  call ser 'the name'    _ x _  " isn't alphabetic"
                                    names=;   iterate getIDs
                               end
            if wordpos(x, names)>0  then do; call ser 'the name' _ x _ " is already taken"
                                             names=;   iterate getIDs
                                         end
            names= space(names x)
            end   /*j*/
          end     /*getIDs*/
       say
       players= words(names)
          do until ans\==''
          say eye 'The '    players     " player's names are: "    names
          say eye 'Is this correct?';   pull ans;  ans= space(ans)
          end   /*until*/
       yeahs= 'yah yeah yes ja oui si da';   upper yeahs
          do ya=1  for words(yeahs)
          if abbrev( word(yeahs, ya), ans, 2) | ans=='Y'  then return
          end   /*ya*/
       call IDS;                                               return
/*──────────────────────────────────────────────────────────────────────────────────────*/
read: _= '───';       eye= copies('─', 8)        /*define a couple of eye catchers.     */
      say;   say eye eye eye  'Welcome to the  WORDIFF  word game.'  eye eye eye;    say
      @.= 0;           starters= 0
            do r=1  while lines(iFID)\==0        /*read each word in the file  (word=X).*/
            x= strip(linein(iFID))               /*pick off a word from the input line. */
            if \isMix(x)  then iterate           /*Not a suitable word for WORDIFF? Skip*/
            y= x;    upper x                     /*pick off a word from the input line. */
            @.x= 1;  L= length(x)                /*set a semaphore for uppercased word. */
            if L<3 | L>4  then iterate           /*only use short words for the start.  */
            starters= starters + 1               /*bump the count of starter words.     */
            $$$.starters= y                      /*save short words for the starter word*/
            end   /*#*/
      if r>100  &  starters> 10  then return     /*is the dictionary satisfactory ?     */
      call ser 'Dictionary file ' _ iFID _ "wasn't found or isn't satisfactory.";  exit 13


#!/usr/bin/perl

use utf8;
use strict;
binmode STDOUT, ":utf8";

my (@tgt, %names);
sub setprops {
	my %h = @_;
	my @p = keys %h;
	for my $p (@p) {
		my @v = @{ $h{$p} };
		@tgt = map(+{idx=>$_-1, map{ ($_, undef) } @p}, 1 .. @v)
			unless @tgt;
		$names{$_} = $p for @v;
	}
}

my $solve = sub {
	for my $i (@tgt) {
		printf("%12s", ucfirst($i->{$_} // "¿Qué?"))
				for reverse sort keys %$i;
		print "\n";
	}
	"there is only one"  # <--- change this to a false value to find all solutions (if any)
};

sub pair {
	my ($a, $b, @v) = @_;
	if ($a =~ /^(\d+)$/) {
		$tgt[$1]{ $names{$b} } = $b;
		return;
	}

	@v = (0) unless @v;
	my %allowed;
	$allowed{$_} = 1 for @v;

	my ($p1, $p2) = ($names{$a}, $names{$b});

	my $e = $solve;
	$solve = sub {		# <--- sorta like how TeX \let...\def macro
		my ($x, $y);

		($x) = grep { $_->{$p1} eq $a } @tgt;
		($y) = grep { $_->{$p2} eq $b } @tgt;

		$x and $y and
			return $allowed{ $x->{idx} - $y->{idx} } && $e->();

		my $try_stuff = sub {
			my ($this, $p, $v, $sign) = @_;
			for (@v) {
				my $i = $this->{idx} + $sign * $_;
				next unless $i >= 0 && $i < @tgt && !$tgt[$i]{$p};
				local $tgt[$i]{$p} = $v;
				$e->() and return 1;
			}
			return
		};

		$x and return $try_stuff->($x, $p2, $b, 1);
		$y and return $try_stuff->($y, $p1, $a, -1);

		for $x (@tgt) {
			next if $x->{$p1};
			local $x->{$p1} = $a;
			$try_stuff->($x, $p2, $b, 1) and return 1;
		}
	};
}

# ---- above should be generic for all similar puzzles ---- #

# ---- below: per puzzle setup ---- #
# property names and values
setprops (
	# Svensk n. a Swede, not a swede (kålrot).
	# AEnglisk (from middle Viking "Æŋløsåksen") n. a Brit.
	'Who'	=> [ qw(Deutsch Svensk Norske Danske AEnglisk) ],
	'Pet'	=> [ qw(birds dog horse zebra cats) ],
	'Drink'	=> [ qw(water tea milk beer coffee) ],
	'Smoke'	=> [ qw(dunhill blue_master prince blend pall_mall) ],
	'Color'	=> [ qw(red green yellow white blue) ]
);

# constraints
pair qw( AEnglisk red );
pair qw( Svensk dog );
pair qw( Danske tea );
pair qw( green white 1 );	# "to the left of" can mean either 1 or -1: ambiguous
pair qw( coffee green );
pair qw( pall_mall birds );
pair qw( yellow dunhill );
pair qw( 2 milk );
pair qw( 0 Norske );
pair qw( blend cats -1 1 );
pair qw( horse dunhill -1 1 );
pair qw( blue_master beer );	# Nicht das Deutsche Bier trinken? Huh.
pair qw( Deutsch prince );
pair qw( Norske blue -1 1 );
pair qw( water blend -1 1 );

$solve->();


import os
import rand
import time
import arrays

fn is_wordiff(guesses []string, word string, dict []string) bool {
    if word !in dict {
        println('That word is not in the dictionary')
        return false
    }
    if word in guesses {
        println('That word has already been used')
        return false
    }
    if word.len < guesses[guesses.len-1].len {
        return is_wordiff_removal(word, guesses[guesses.len-1])
    } else if word.len > guesses[guesses.len-1].len {
        return is_wordiff_insertion(word, guesses[guesses.len-1])
    }
    return is_wordiff_change(word,guesses[guesses.len-1])
}
fn is_wordiff_removal(new_word string, last_word string) bool {
    for i in 0..last_word.len {
        if new_word == last_word[..i] + last_word[i+1..] {
            return true
        }
    }
    println('Word is not derived from previous by removal of one letter')
    return false
}
fn is_wordiff_insertion(new_word string, last_word string) bool {
    if new_word.len > last_word.len+1 {
        println('More than one character insertion difference')
        return false
    }
    mut a := new_word.split('')
    b := last_word.split('')
    for c in b {
        idx := a.index(c)
        if idx >=0 {
            a.delete(idx)
        }
    }
    if a.len >1 {
        println('Word is not derived from previous by insertion of one letter')
        return false
    }
    return true
}
fn is_wordiff_change(new_word string, last_word string) bool  {
    mut diff:=0
    for i,c in new_word {
        if c != last_word[i] {
            diff++
        }
    }
    if diff != 1 {
        println('More or less than exactly one character changed')
        return false
    }
    return true
}

fn main() {
    words := os.read_lines('unixdict.txt')?
    time_limit := os.input('Time limit (sec) or 0 for none: ').int()
    players := os.input('Please enter player names, separated by commas: ').split(',')

    dic_3_4 := words.filter(it.len in [3,4])
    mut wordiffs := rand.choose<string>(dic_3_4,1)?
    mut timing := [][]f64{len: players.len}
    start := time.now()
    mut turn_count := 0
    for {
        turn_start := time.now()
        word := os.input('${players[turn_count%players.len]}: Input a wordiff from ${wordiffs[wordiffs.len-1]}: ')
        if time_limit != 0.0 && time.since(start).seconds()>time_limit{
            println('TIMES UP ${players[turn_count%players.len]}')
            break
        } else {
            if is_wordiff(wordiffs, word, words) {
                wordiffs<<word
            }else{
                timing[turn_count%players.len] << time.since(turn_start).seconds()
                println('YOU HAVE LOST ${players[turn_count%players.len]}')
                break
            }
        }
        timing[turn_count%players.len] << time.since(turn_start).seconds()
        turn_count++
    }
    println('Timing ranks:')
    for i,p in timing {
        sum := arrays.sum<f64>(p) or {0}
        println('  ${players[i]}: ${sum/p.len:10.3 f} seconds average')
    }
}


import "random" for Random
import "/ioutil" for File, Input
import "/str" for Str
import "/sort" for Find

var rand = Random.new()
var words = File.read("unixdict.txt").trim().split("\n")

var player1 = Input.text("Player 1, please enter your name : ", 1)
var player2 = Input.text("Player 2, please enter your name : ", 1)
if (player2 == player1) player2 = player2 + "2"

var words3or4 = words.where { |w| w.count == 3 || w.count == 4 }.toList
var n = words3or4.count
var firstWord = words3or4[rand.int(n)]
var prevLen = firstWord.count
var prevWord = firstWord
var used = []
var player = player1
System.print("\nThe first word is %(firstWord)\n")
while (true) {
    var word = Str.lower(Input.text("%(player), enter your word : ", 1))
    var len = word.count
    var ok = false
    if (len < 3) {
        System.print("Words must be at least 3 letters long.")
    } else if (Find.first(words, word) == -1) {
        System.print("Not in dictionary.")
    } else if (used.contains(word)) {
        System.print("Word has been used before.")
    } else if (word == prevWord) {
        System.print("You must change the previous word.")
    } else if (len == prevLen) {
        var changes = 0
        for (i in 0...len) {
            if (word[i] != prevWord[i]) {
                changes = changes + 1
            }
        }
        if (changes > 1) {
            System.print("Only one letter can be changed.")
        } else ok = true
    } else if (len == prevLen + 1) {
        var addition = false
        var temp = word
        for (i in 0...prevLen) {
            if (word[i] != prevWord[i]) {
                addition = true
                temp = Str.delete(temp, i)
                if (temp == prevWord) {
                    ok = true
                }
                break
            }
        }
        if (!addition) ok = true
        if (!ok) System.print("Invalid addition.")
    } else if (len == prevLen - 1) {
        var deletion = false
        var temp = prevWord
        for (i in 0...len) {
            if (word[i] != prevWord[i]) {
                deletion = true
                temp = Str.delete(temp, i)
                if (temp == word) {
                    ok = true
                }
                break
            }
        }
        if (!deletion) ok = true
        if (!ok) System.print("Invalid deletion.")
    } else {
        System.print("Invalid change.")
    }
    if (ok) {
        prevLen = word.count
        prevWord = word
        used.add(word)
        player = (player == player1) ? player2 : player1
    } else {
        System.print("So, sorry %(player), you've lost!")
        return
    }
}


enum Colour, Nationality, Drink, Smoke, Pet
constant Colours = {"red","white","green","yellow","blue"},
         Nationalities = {"English","Swede","Dane","Norwegian","German"},
         Drinks = {"tea","coffee","milk","beer","water"},
         Smokes = {"Pall Mall","Dunhill","Blend","Blue Master","Prince"},
         Pets = {"dog","birds","cats","horse","zebra"},
         Sets = {Colours,Nationalities,Drinks,Smokes,Pets}

constant tagset5 = tagset(5)        -- {1,2,3,4,5}, oft-permuted
sequence perm = repeat(tagset5,5)   -- perm[1] is Colour of each house, etc

function house(integer i, string name)
    return find(find(name,Sets[i]),perm[i])
end function

function left_of(integer h1, integer h2)
    return (h1-h2)==1
end function

function next_to(integer h1, integer h2)
    return abs(h1-h2)==1
end function

procedure print_house(integer i)
    printf(1,"%d:%s,%s,%s,%s,%s\n",{i,
                                    Colours[perm[Colour][i]],
                                    Nationalities[perm[Nationality][i]],
                                    Drinks[perm[Drink][i]],
                                    Smokes[perm[Smoke][i]],
                                    Pets[perm[Pet][i]]})
end procedure

integer solutions = 0
sequence solperms = {}
atom t0 = time()
constant factorial5 = factorial(5)
for C=1 to factorial5 do
    perm[Colour] = permute(C,tagset5)
    if left_of(house(Colour,"green"),house(Colour,"white")) then
        for N=1 to factorial5 do
            perm[Nationality] = permute(N,tagset5)
            if house(Nationality,"Norwegian")==1
            and house(Nationality,"English")==house(Colour,"red")
            and next_to(house(Nationality,"Norwegian"),house(Colour,"blue")) then
                for D=1 to factorial5 do
                    perm[Drink] = permute(D,tagset5)
                    if house(Nationality,"Dane")==house(Drink,"tea")
                    and house(Drink,"coffee")==house(Colour,"green")
                    and house(Drink,"milk")==3 then
                        for S=1 to factorial5 do
                            perm[Smoke] = permute(S,tagset5)
                            if house(Colour,"yellow")==house(Smoke,"Dunhill")
                            and house(Nationality,"German")==house(Smoke,"Prince")
                            and house(Smoke,"Blue Master")==house(Drink,"beer")
                            and next_to(house(Drink,"water"),house(Smoke,"Blend")) then
                                for P=1 to factorial5 do
                                    perm[Pet] = permute(P,tagset5)
                                    if house(Nationality,"Swede")==house(Pet,"dog")
                                    and house(Smoke,"Pall Mall")==house(Pet,"birds")
                                    and next_to(house(Smoke,"Blend"),house(Pet,"cats"))
                                    and next_to(house(Pet,"horse"),house(Smoke,"Dunhill")) then
                                        for i=1 to 5 do
                                            print_house(i)
                                        end for
                                        solutions += 1
                                        solperms = append(solperms,perm)
                                    end if
                                end for
                            end if
                        end for
                    end if
                end for
            end if
        end for
    end if
end for
printf(1,"%d solution%s found (%3.3fs).\n",{solutions,iff(solutions>1,"s",""),time()-t0})
for i=1 to length(solperms) do
    perm = solperms[i]
    printf(1,"The %s owns the Zebra\n",{Nationalities[house(Pet,"zebra")]})
end for


import cp.

main =>
   Nat        = [English, Swede, Dane, German, Norwegian],
   Color      = [Red, Green, White, Yellow, Blue],
   Smoke      = [PallMall, Dunhill, Blend, SBlue, Prince],
   Pet        = [Dog, Bird, Cat, Horse, Zebra],
   Drink      = [Tea, Coffee, Milk, Beer, Water],

   Nat        :: 1..5,
   Color      :: 1..5,
   Smoke      :: 1..5,
   Pet        :: 1..5,
   Drink      :: 1..5,

   all_different(Nat),
   all_different(Color),
   all_different(Smoke),
   all_different(Pet),
   all_different(Drink),

   English = Red,
   Swede = Dog,
   Dane = Tea,
   Green #= White-1,
   Coffee = Green,
   Bird = PallMall,
   Yellow = Dunhill,
   Milk = 3,
   Norwegian = 1,
   abs(Blend-Cat) #= 1,
   abs(Dunhill-Horse) #= 1,
   SBlue = Beer,
   German = Prince,
   abs(Norwegian-Blue) #= 1,
   abs(Blend-Water) #= 1,

   solve(Nat ++ Color ++ Smoke ++ Pet ++ Drink),

   L = [English=english,
        Swede=swede,
        Dane=dane,
        German=german,
        Norwegian=norwegian].sort(),
   member(Zebra=ZebraOwner, L),
   writef("The %w owns the zebra\n", ZebraOwner),
   writeln(L).


(be match (@House @Person @Drink @Pet @Cigarettes)
   (permute (red blue green yellow white) @House)
   (left-of @House white  @House green)

   (permute (Norwegian English Swede German Dane) @Person)
   (has @Person English  @House red)
   (equal @Person (Norwegian . @))
   (next-to @Person Norwegian  @House blue)

   (permute (tea coffee milk beer water) @Drink)
   (has @Drink tea  @Person Dane)
   (has @Drink coffee  @House green)
   (equal @Drink (@ @ milk . @))

   (permute (dog birds cats horse zebra) @Pet)
   (has @Pet dog  @Person Swede)

   (permute (Pall-Mall Dunhill Blend Blue-Master Prince) @Cigarettes)
   (has @Cigarettes Pall-Mall  @Pet birds)
   (has @Cigarettes Dunhill  @House yellow)
   (next-to @Cigarettes Blend  @Pet cats)
   (next-to @Cigarettes Dunhill  @Pet horse)
   (has @Cigarettes Blue-Master  @Drink beer)
   (has @Cigarettes Prince  @Person German)

   (next-to @Drink water  @Cigarettes Blend) )

(be has ((@A . @X) @A (@B . @Y) @B))
(be has ((@ . @X) @A (@ . @Y) @B)
   (has @X @A @Y @B) )

(be right-of ((@A . @X) @A (@ @B . @Y) @B))
(be right-of ((@ . @X) @A (@ . @Y) @B)
   (right-of @X @A @Y @B) )

(be left-of ((@ @A . @X) @A (@B . @Y) @B))
(be left-of ((@ . @X) @A (@ . @Y) @B)
   (left-of @X @A @Y @B) )

(be next-to (@X @A @Y @B) (right-of @X @A @Y @B))
(be next-to (@X @A @Y @B) (left-of @X @A @Y @B))


select([A|As],S):- select(A,S,S1),select(As,S1).
select([],_).

next_to(A,B,C):- left_of(A,B,C) ; left_of(B,A,C).
left_of(A,B,C):- append(_,[A,B|_],C).

zebra(Owns, HS):-  % color,nation,pet,drink,smokes
      HS =    [ h(_,norwegian,_,_,_), _,  h(_,_,_,milk,_), _, _],
      select( [ h(red,englishman,_,_,_),  h(_,swede,dog,_,_),
                h(_,dane,_,tea,_),        h(_,german,_,_,prince) ], HS),
      select( [ h(_,_,birds,_,pallmall),  h(yellow,_,_,_,dunhill),
                h(_,_,_,beer,bluemaster) ],                         HS),
      left_of(  h(green,_,_,coffee,_),    h(white,_,_,_,_),         HS),
      next_to(  h(_,_,_,_,dunhill),       h(_,_,horse,_,_),         HS),
      next_to(  h(_,_,_,_,blend),         h(_,_,cats, _,_),         HS),
      next_to(  h(_,_,_,_,blend),         h(_,_,_,water,_),         HS),
      next_to(  h(_,norwegian,_,_,_),     h(blue,_,_,_,_),          HS),
      member(   h(_,Owns,zebra,_,_), HS).

:- ?- time(( zebra(Who, HS), maplist(writeln,HS), nl, write(Who), nl, nl, fail
             ; write('No more solutions.') )).


from logpy import *
from logpy.core import lall
import time

def lefto(q, p, list):
	# give me q such that q is left of p in list
	# zip(list, list[1:]) gives a list of 2-tuples of neighboring combinations
	# which can then be pattern-matched against the query
	return membero((q,p), zip(list, list[1:]))

def nexto(q, p, list):
	# give me q such that q is next to p in list
	# match lefto(q, p) OR lefto(p, q)
	# requirement of vector args instead of tuples doesn't seem to be documented
	return conde([lefto(q, p, list)], [lefto(p, q, list)])

houses = var()

zebraRules = lall(
	# there are 5 houses
	(eq, 		(var(), var(), var(), var(), var()), houses),
	# the Englishman's house is red
	(membero,	('Englishman', var(), var(), var(), 'red'), houses),
	# the Swede has a dog
	(membero,	('Swede', var(), var(), 'dog', var()), houses),
	# the Dane drinks tea
	(membero,	('Dane', var(), 'tea', var(), var()), houses),
	# the Green house is left of the White house
	(lefto,		(var(), var(), var(), var(), 'green'),
				(var(), var(), var(), var(), 'white'), houses),
	# coffee is the drink of the green house
	(membero,	(var(), var(), 'coffee', var(), 'green'), houses),
	# the Pall Mall smoker has birds
	(membero,	(var(), 'Pall Mall', var(), 'birds', var()), houses),
	# the yellow house smokes Dunhills
	(membero,	(var(), 'Dunhill', var(), var(), 'yellow'), houses),
	# the middle house drinks milk
	(eq,		(var(), var(), (var(), var(), 'milk', var(), var()), var(), var()), houses),
	# the Norwegian is the first house
	(eq,		(('Norwegian', var(), var(), var(), var()), var(), var(), var(), var()), houses),
	# the Blend smoker is in the house next to the house with cats
	(nexto,		(var(), 'Blend', var(), var(), var()),
				(var(), var(), var(), 'cats', var()), houses),
	# the Dunhill smoker is next to the house where they have a horse
	(nexto,		(var(), 'Dunhill', var(), var(), var()),
				(var(), var(), var(), 'horse', var()), houses),
	# the Blue Master smoker drinks beer
	(membero,	(var(), 'Blue Master', 'beer', var(), var()), houses),
	# the German smokes Prince
	(membero,	('German', 'Prince', var(), var(), var()), houses),
	# the Norwegian is next to the blue house
	(nexto,		('Norwegian', var(), var(), var(), var()),
				(var(), var(), var(), var(), 'blue'), houses),
	# the house next to the Blend smoker drinks water
	(nexto,		(var(), 'Blend', var(), var(), var()),
				(var(), var(), 'water', var(), var()), houses),
	# one of the houses has a zebra--but whose?
	(membero,	(var(), var(), var(), 'zebra', var()), houses)
)

t0 = time.time()
solutions = run(0, houses, zebraRules)
t1 = time.time()
dur = t1-t0

count = len(solutions)
zebraOwner = [house for house in solutions[0] if 'zebra' in house][0][0]

print "%i solutions in %.2f seconds" % (count, dur)
print "The %s is the owner of the zebra" % zebraOwner
print "Here are all the houses:"
for line in solutions[0]:
	print str(line)


library(combinat)

col <- factor(c("Red","Green","White","Yellow","Blue"))
own <- factor(c("English","Swedish","Danish","German","Norwegian"))
pet <- factor(c("Dog","Birds","Cats","Horse","Zebra"))
drink <- factor(c("Coffee","Tea","Milk","Beer","Water"))
smoke <- factor(c("PallMall", "Blend", "Dunhill", "BlueMaster", "Prince"))

col_p <- permn(levels(col))
own_p <- permn(levels(own))
pet_p <- permn(levels(pet))
drink_p <- permn(levels(drink))
smoke_p <- permn(levels(smoke))

imright <- function(h1,h2){
  return(h1-h2==1)
}

nextto <- function(h1,h2){
  return(abs(h1-h2)==1)
}

house_with <- function(f,val){
  return(which(levels(f)==val))
}

for (i in seq(length(col_p))){
  col <- factor(col, levels=col_p[[i]])

  if (imright(house_with(col,"Green"),house_with(col,"White"))) {
    for (j in seq(length(own_p))){
      own <- factor(own, levels=own_p[[j]])

      if(house_with(own,"English") == house_with(col,"Red")){
        if(house_with(own,"Norwegian") == 1){
          if(nextto(house_with(own,"Norwegian"),house_with(col,"Blue"))){
            for(k in seq(length(drink_p))){
              drink <- factor(drink, levels=drink_p[[k]])

              if(house_with(drink,"Coffee") == house_with(col,"Green")){
                if(house_with(own,"Danish") == house_with(drink,"Tea")){
                  if(house_with(drink,"Milk") == 3){
                    for(l in seq(length(smoke_p))){
                      smoke <- factor(smoke, levels=smoke_p[[l]])

                      if(house_with(smoke,"Dunhill") == house_with(col,"Yellow")){
                        if(house_with(smoke,"BlueMaster") == house_with(drink,"Beer")){
                          if(house_with(own,"German") == house_with(smoke,"Prince")){
                            if(nextto(house_with(smoke,"Blend"),house_with(drink,"Water"))){
                              for(m in seq(length(pet_p))){
                                pet <- factor(pet, levels=pet_p[[m]])

                                if(house_with(own,"Swedish") == house_with(pet,"Dog")){
                                  if(house_with(smoke,"PallMall") == house_with(pet,"Birds")){
                                    if(nextto(house_with(smoke,"Blend"),house_with(pet,"Cats"))){
                                      if(nextto(house_with(smoke,"Dunhill"),house_with(pet,"Horse"))){
                                        res <- sapply(list(own,col,pet,smoke,drink),levels)
                                        colnames(res) <- c("Nationality","Colour","Pet","Drink","Smoke")
                                        print(res)
                                      }
                                    }
                                  }
                                }
                              }
                            }
                          }
                        }
                      }
                    }
                  }
                }
              }
            }
          }
        }
      }
    }
  }

}


#lang racket

(require racklog)

(define %select
  (%rel (x xs S S1)
    [(x (cons x xs) xs)]
    [(x (cons S xs) (cons S S1)) (%select x xs S1)]
    [((cons x xs) S)
     (%select x S S1)
     (%select xs S1)]
    [('() (_))]))

(define %next-to
  (%rel (A B C)
    [(A B C)
     (%or (%left-of A B C)
          (%left-of B A C))]))

(define %left-of
  (%rel (A B C)
    [(A B C) (%append (_) (cons A (cons B (_))) C)]))

(define %zebra
  (%rel (Owns HS)
    [(Owns HS)
     (%is HS (list (list (_) 'norwegian (_) (_) (_))
                   (_)
                   (list (_) (_) (_) 'milk (_))
                   (_) (_)))
     (%select (list (list 'red 'englishman (_) (_) (_))
                    (list (_) 'swede 'dog (_) (_))
                    (list (_) 'dane (_) 'tea (_))
                    (list (_) 'german (_) (_) 'prince))
              HS)
     (%select (list (list (_) (_) 'birds (_) 'pallmall)
                    (list 'yellow (_) (_) (_) 'dunhill)
                    (list (_) (_) (_) 'beer 'bluemaster))
              HS)
     (%left-of (list 'green (_) (_) 'coffee (_))
               (list 'white (_) (_) (_) (_))
               HS)
     (%next-to (list (_) (_) (_) (_) 'dunhill)
               (list (_) (_) 'horse (_) (_))
               HS)
     (%next-to (list (_) (_) (_) (_) 'blend)
               (list (_) (_) 'cats (_) (_))
               HS)
     (%next-to (list (_) (_) (_) (_) 'blend)
               (list (_) (_) (_) 'water (_))
               HS)
     (%next-to (list (_) 'norwegian (_) (_) (_))
               (list 'blue (_) (_) (_) (_))
               HS)
     (%member (list (_) Owns 'zebra (_) (_)) HS)]))

(%which (Who HS) (%zebra Who HS))


V s =
|‘  XX
     X
     X
     X
     X
     X
   XXXXX’

V lines = s.split("\n")
V width = max(lines.map(l -> l.len))

L(line) lines
   print((‘ ’ * (lines.len - L.index - 1))‘’(line.ljust(width).replace(‘ ’, ‘   ’).replace(‘X’, ‘__/’) * 3))


my Hash @houses = (1 .. 5).map: { %(:num($_)) }; # 1 there are five houses

my @facts = (
    { :nat<English>, :color<red> },      # 2 The English man lives in the red house.
    { :nat<Swede>, :pet<dog> },          # 3 The Swede has a dog.
    { :nat<Dane>, :drink<tea> },         # 4 The Dane drinks tea.
    { :color<green>, :Left-Of(:color<white>) }, # 5 the green house is immediately to the left of the white house
    { :drink<coffee>, :color<green> },   # 6 They drink coffee in the green house.
    { :smoke<Pall-Mall>, :pet<birds> },  # 7 The man who smokes Pall Mall has birds.
    { :color<yellow>, :smoke<Dunhill> }, # 8 In the yellow house they smoke Dunhill.
    { :num(3), :drink<milk> },           # 9 In the middle house they drink milk.
    { :num(1), :nat<Norwegian> },        # 10 The Norwegian lives in the first house.
    { :smoke<Blend>, :Next-To(:pet<cats>) }, # 11 The man who smokes Blend lives in the house next to the house with cats.
    { :pet<horse>, :Next-To(:smoke<Dunhill>) }, # 12 In a house next to the house where they have a horse, they smoke Dunhill.
    { :smoke<Blue-Master>, :drink<beer> }, # 13 The man who smokes Blue Master drinks beer.
    { :nat<German>, :smoke<Prince> },      # 14 The German smokes Prince.
    { :nat<Norwegian>, :Next-To(:color<blue>) }, # 15 The Norwegian lives next to the blue house.
    { :drink<water>, :Next-To(:smoke<Blend>) },  # 16 They drink water in a house next to the house where they smoke Blend.
    { :pet<zebra> }, # who owns this?
);

sub MAIN {
    for gather solve(@houses, @facts) {
        #-- output
        say .head.sort.map(*.key.uc.fmt("%-9s")).join(' | ');
        say .sort.map(*.value.fmt("%-9s")).join(' | ')
            for .list;
        last; # stop after first solution
    }
}

#| a solution has been found that fits all the facts
multi sub solve(@solution, @facts [ ]) {
    take @solution;
}

#| extend this scenario to fit the next fact
multi sub solve(@scenario, [ $fact, *@facts ]) {
    for gather match(@scenario, |$fact) -> @houses {
        solve(@houses, @facts)
    }
}

#| find all possible solutions for pairs of houses with
#| properties %b, left of a house  with properties %a
multi sub match(@houses, :Left-Of(%a)!, *%b) {
    for 1 ..^ @houses {
        my %left-house  := @houses[$_-1];
        my %right-house := @houses[$_];

        if plausible(%left-house, %a) && plausible(%right-house, %b) {
            temp %left-house  ,= %a;
            temp %right-house ,= %b;
            take @houses;
        }
    }
}

#| match these houses are next to each other (left or right)
multi sub match(@houses, :Next-To(%b)!, *%a ) {
    match(@houses, |%a, :Left-Of(%b) );
    match(@houses, |%b, :Left-Of(%a) );
}

#| find all possible houses that match the given properties
multi sub match(@houses, *%props) {
    for @houses.grep({plausible($_, %props)}) -> %house {
        temp %house ,= %props;
        take @houses;
    }
}

#| plausible if doesn't conflict with anything
sub plausible(%house, %props) {
   ! %props.first: {%house{.key} && %house{.key} ne .value };
}


/* REXX ---------------------------------------------------------------
* Solve the Zebra Puzzle
*--------------------------------------------------------------------*/
  Call mk_perm    /* compute all permutations                        */
  Call encode     /* encode the elements of the specifications       */
  /* ex2 .. eg16     the formalized specifications                   */
  solutions=0
  Call time 'R'
  Do nation_i = 1 TO 120
    Nations = perm.nation_i
    IF ex10() Then Do
      Do color_i = 1 TO 120
        Colors = perm.color_i
        IF ex5() & ex2() & ex15() Then Do
          Do drink_i = 1 TO 120
            Drinks = perm.drink_i
            IF ex9() & ex4() & ex6() Then Do
              Do smoke_i = 1 TO 120
                Smokes = perm.smoke_i
                IF ex14() & ex13() & ex16() & ex8() Then Do
                   Do animal_i = 1 TO 120
                    Animals = perm.animal_i
                    IF ex3() & ex7() & ex11() & ex12() Then Do
                      /* Call out 'Drinks =' Drinks  54321 Wat Tea Mil Cof Bee */
                      /* Call out 'Nations=' Nations 41235 Nor Den Eng Ger Swe */
                      /* Call out 'Colors =' Colors  51324 Yel Blu Red Gre Whi */
                      /* Call out 'Smokes =' Smokes  31452 Dun Ble Pal Pri Blu */
                      /* Call out 'Animals=' Animals 24153 Cat Hor Bir Zeb Dog */
                      Call out 'House   Drink      Nation     Colour'||,
                                                         '     Smoke      Animal'
                      Do i=1 To 5
                        di=substr(drinks,i,1)
                        ni=substr(nations,i,1)
                        ci=substr(colors,i,1)
                        si=substr(smokes,i,1)
                        ai=substr(animals,i,1)
                        ol.i=right(i,3)'     '||left(drink.di,11),
                                              ||left(nation.ni,11),
                                              ||left(color.ci,11),
                                              ||left(smoke.si,11),
                                              ||left(animal.ai,11)
                        Call out ol.i
                        End
                      solutions=solutions+1
                      End
                    End /* animal_i */
                  End
                End /* smoke_i */
              End
            End /* drink_i */
          End
        End /* color_i */
      End
    End /* nation_i */
  Say 'Number of solutions =' solutions
  Say 'Solved in' time('E') 'seconds'
Exit

/*------------------------------------------------------------------------------
      #There are five houses.
ex2:  #The English man lives in the red house.
ex3:  #The Swede has a dog.
ex4:  #The Dane drinks tea.
ex5:  #The green house is immediately to the left of the white house.
ex6:  #They drink coffee in the green house.
ex7:  #The man who smokes Pall Mall has birds.
ex8:  #In the yellow house they smoke Dunhill.
ex9:  #In the middle house they drink milk.
ex10: #The Norwegian lives in the first house.
ex11: #The man who smokes Blend lives in the house next to the house with cats.
ex12: #In a house next to the house where they have a horse, they smoke Dunhill.
ex13: #The man who smokes Blue Master drinks beer.
ex14: #The German smokes Prince.
ex15: #The Norwegian lives next to the blue house.
ex16: #They drink water in a house next to the house where they smoke Blend.
------------------------------------------------------------------------------*/
ex2:  Return pos(England,Nations)=pos(Red,Colors)
ex3:  Return pos(Sweden,Nations)=pos(Dog,Animals)
ex4:  Return pos(Denmark,Nations)=pos(Tea,Drinks)
ex5:  Return pos(Green,Colors)=pos(White,Colors)-1
ex6:  Return pos(Coffee,Drinks)=pos(Green,Colors)
ex7:  Return pos(PallMall,Smokes)=pos(Birds,Animals)
ex8:  Return pos(Dunhill,Smokes)=pos(Yellow,Colors)
ex9:  Return substr(Drinks,3,1)=Milk
ex10: Return left(Nations,1)=Norway
ex11: Return abs(pos(Blend,Smokes)-pos(Cats,Animals))=1
ex12: Return abs(pos(Dunhill,Smokes)-pos(Horse,Animals))=1
ex13: Return pos(BlueMaster,Smokes)=pos(Beer,Drinks)
ex14: Return pos(Germany,Nations)=pos(Prince,Smokes)
ex15: Return abs(pos(Norway,Nations)-pos(Blue,Colors))=1
ex16: Return abs(pos(Blend,Smokes)-pos(Water,Drinks))=1

mk_perm: Procedure Expose perm.
/*---------------------------------------------------------------------
* Make all permutations of 12345 in perm.*
*--------------------------------------------------------------------*/
perm.=0
n=5
Do pop=1 For n
  p.pop=pop
  End
Call store
Do While nextperm(n,0)
  Call store
  End
Return

nextperm: Procedure Expose p. perm.
  Parse Arg n,i
  nm=n-1
  Do k=nm By-1 For nm
    kp=k+1
    If p.k<p.kp Then Do
      i=k
      Leave
      End
    End
  Do j=i+1 While j<n
    Parse Value p.j p.n With p.n p.j
    n=n-1
    End
  If i>0 Then Do
    Do j=i+1 While p.j<p.i
      End
    Parse Value p.j p.i With p.i p.j
    End
  Return i>0

store: Procedure Expose p. perm.
  z=perm.0+1
    _=''
    Do j=1 To 5
      _=_||p.j
      End
  perm.z=_
  perm.0=z
  Return

encode:
  Beer=1         ; Drink.1='Beer'
  Coffee=2       ; Drink.2='Coffee'
  Milk=3         ; Drink.3='Milk'
  Tea=4          ; Drink.4='Tea'
  Water=5        ; Drink.5='Water'
  Denmark=1      ; Nation.1='Denmark'
  England=2      ; Nation.2='England'
  Germany=3      ; Nation.3='Germany'
  Norway=4       ; Nation.4='Norway'
  Sweden=5       ; Nation.5='Sweden'
  Blue=1         ; Color.1='Blue'
  Green=2        ; Color.2='Green'
  Red=3          ; Color.3='Red'
  White=4        ; Color.4='White'
  Yellow=5       ; Color.5='Yellow'
  Blend=1        ; Smoke.1='Blend'
  BlueMaster=2   ; Smoke.2='BlueMaster'
  Dunhill=3      ; Smoke.3='Dunhill'
  PallMall=4     ; Smoke.4='PallMall'
  Prince=5       ; Smoke.5='Prince'
  Birds=1        ; Animal.1='Birds'
  Cats=2         ; Animal.2='Cats'
  Dog=3          ; Animal.3='Dog'
  Horse=4        ; Animal.4='Horse'
  Zebra=5        ; Animal.5='Zebra'
  Return

out:
  Say arg(1)
  Return


# syntax: GAWK -f WRITE_LANGUAGE_NAME_IN_3D_ASCII.AWK
BEGIN {
    arr[1] = " xxxx    x    x   x   x"
    arr[2] = "x    x   x    x   x  x"
    arr[3] = "x    x   x    x   x x"
    arr[4] = "xxxxxx   x    x   xx"
    arr[5] = "x    x   x xx x   xx"
    arr[6] = "x    x   xx  xx   x x"
    arr[7] = "x    x   xx  xx   x  x"
    arr[8] = "A    V   P    J   B   W"
    for (i=1; i<=8; i++) {
      x = arr[i]
      gsub(/./,"& ",x)
      gsub(/[xA-Z] /,"_/",x)
      print(x)
    }
    exit(0)
}


CONTENT = { House:       '',
            Nationality: %i[English Swedish Danish Norwegian German],
            Colour:      %i[Red Green White Blue Yellow],
            Pet:         %i[Dog Birds Cats Horse Zebra],
            Drink:       %i[Tea Coffee Milk Beer Water],
            Smoke:       %i[PallMall Dunhill BlueMaster Prince Blend] }

def adjacent? (n,i,g,e)
  (0..3).any?{|x| (n[x]==i and g[x+1]==e) or (n[x+1]==i and g[x]==e)}
end

def leftof? (n,i,g,e)
  (0..3).any?{|x| n[x]==i and g[x+1]==e}
end

def coincident? (n,i,g,e)
  n.each_index.any?{|x| n[x]==i and g[x]==e}
end

def solve_zebra_puzzle
  CONTENT[:Nationality].permutation{|nation|
    next unless nation.first == :Norwegian                              # 10
    CONTENT[:Colour].permutation{|colour|
      next unless leftof?(colour, :Green, colour, :White)               # 5
      next unless coincident?(nation, :English, colour, :Red)           # 2
      next unless adjacent?(nation, :Norwegian, colour, :Blue)          # 15
      CONTENT[:Pet].permutation{|pet|
        next unless coincident?(nation, :Swedish, pet, :Dog)            # 3
        CONTENT[:Drink].permutation{|drink|
          next unless drink[2] == :Milk                                 # 9
          next unless coincident?(nation, :Danish, drink, :Tea)         # 4
          next unless coincident?(colour, :Green, drink, :Coffee)       # 6
          CONTENT[:Smoke].permutation{|smoke|
            next unless coincident?(smoke, :PallMall, pet, :Birds)      # 7
            next unless coincident?(smoke, :Dunhill, colour, :Yellow)   # 8
            next unless coincident?(smoke, :BlueMaster, drink, :Beer)   # 13
            next unless coincident?(smoke, :Prince, nation, :German)    # 14
            next unless adjacent?(smoke, :Blend, pet, :Cats)            # 11
            next unless adjacent?(smoke, :Blend, drink, :Water)         # 16
            next unless adjacent?(smoke, :Dunhill,pet, :Horse)          # 12
            print_out(nation, colour, pet, drink, smoke)
  } } } } }
end

def print_out (nation, colour, pet, drink, smoke)
  width = CONTENT.map{|x| x.flatten.map{|y|y.size}.max}
  fmt = width.map{|w| "%-#{w}s"}.join(" ")
  national = nation[ pet.find_index(:Zebra) ]
  puts "The Zebra is owned by the man who is #{national}",""
  puts fmt % CONTENT.keys, fmt % width.map{|w| "-"*w}
  [nation,colour,pet,drink,smoke].transpose.each.with_index(1){|x,n| puts fmt % [n,*x]}
end

solve_zebra_puzzle


10 S$ = "BASIC" : REM OUR LANGUAGE NAME
20 DIM B(5,5) : REM OUR BIGMAP CHARACTERS
30 FOR L = 1 TO 5 : REM 5 CHARACTERS
40     FOR M = 1 TO 5 : REM 5 ROWS
50         READ B(L,M)
60 NEXT M, L

100 GR : REM BLACK BACKGROUND
110 COLOR = 1 : REM OUR SHADOW WILL BE RED
120 HOME : REM CLS
130 R = 9 : REM SHADOW WILL START ON ROW 5
140 C = 2 : REM SHADOW WILL START AT COLUMN 2
150 GOSUB 2000"DRAW SHADOW
160 COLOR = 13 : REM OUR FOREGROUND WILL BE YELLOW
170 R = 10 : REM FOREGROUND WILL START ON ROW 6
180 C = 3 : REM FOREGROUND WILL START ON COLUMN 3
190 GOSUB 2000"DISPLAY THE LANGUAGE NAME

999 STOP

1000 REM CONVERT TO BINARY BIGMAP
1010 T = N : REM TEMPORARY VARIABLE
1020 G$ = "" : REM THIS WILL CONTAIN OUR 5 CHARACTER BINARY BIGMAP
1040 FOR Z = 5 TO 0 STEP -1
1050     D$ = " " : REM ASSUME NEXT DIGIT IS ZERO (DRAW A SPACE)
1055     S = 2 ^ Z
1060     IF T >= S THEN D$ = "*" : T = T - S : REM IS A BLOCK
1070     G$ = G$ + D$
1080 NEXT Z
1090 RETURN

2000 REM DISPLAY THE BIG LETTERS
2010 FOR L = 1 TO 5 : REM OUR 5 ROWS
2020     X = C : Y = R + L - 1 : REM PRINT AT R+L-1,C;
2030     FOR M = 1 TO 5 : REM BIGMAP FOR EACH CHARACTER
2040         N = B(M, L)
2050         GOSUB 1000
2060         FOR I = 1 TO LEN(G$) : IF MID$(G$, I, 1) <> " " THEN PLOT X,Y :REM 5 CHARACTER BIGMAP
2070             X = X + 1 : NEXT I
2080         X = X + 1 : REM PRINT " ";: REM SPACE BETWEEN EACH LETTER
2090 NEXT M, L
2100 RETURN

9000 DATA 30,17,30,17,30: REM B
9010 DATA 14,17,31,17,17: REM A
9020 DATA 15,16,14,1,30: REM S
9030 DATA 31,4,4,4,31: REM I
9040 DATA 14,17,16,17,14: REM C


/* Note to the rules:
 *
 * It can further concluded that:
 * 5a: The green house cannot be at the h1 position
 * 5b: The white house cannot be at the h5 position
 *
 * 16: This rule is redundant.
 */

object Einstein extends App {
  val possibleMembers = for { // pair clues results in 78 members
    nationality <- List("Norwegian", "German", "Dane", "Englishman", "Swede")
    color <- List("Red", "Green", "Yellow", "White", "Blue")
    beverage <- List("Milk", "Coffee", "Tea", "Beer", "Water")
    animal <- List("Dog", "Horse", "Birds", "Cats", "Zebra")
    brand <- List("Blend", "Pall Mall", "Prince", "Blue Master", "Dunhill")
    if (color == "Red") == (nationality == "Englishman") // #2
    if (nationality == "Swede") == (animal == "Dog") // #3
    if (nationality == "Dane") == (beverage == "Tea") // #4
    if (color == "Green") == (beverage == "Coffee") // #6
    if (brand == "Pall Mall") == (animal == "Birds") // #7
    if (brand == "Dunhill") == (color == "Yellow") // #8
    if (brand == "Blue Master") == (beverage == "Beer") // #13
    if (brand == "Prince") == (nationality == "German") // #14
  } yield new House(nationality, color, beverage, animal, brand)
  val members = for { // Neighborhood clues
    h1 <- housesLeftOver().filter(p => (p.nationality == "Norwegian" /* #10 */) && (p.color != "Green") /* #5a */) // 28
    h3 <- housesLeftOver(h1).filter(p => p.beverage == "Milk") // #9 // 24
    h2 <- housesLeftOver(h1, h3).filter(_.color == "Blue") // #15
    if matchMiddleBrandAnimal(h1, h2, h3, "Blend", "Cats") // #11
    if matchCornerBrandAnimal(h1, h2, "Horse", "Dunhill") // #12
    h4 <- housesLeftOver(h1, h2, h3).filter(_.checkAdjacentWhite(h3) /* #5 */)
    h5 <- housesLeftOver(h1, h2, h3, h4)

    //  Redundant tests
    if h2.checkAdjacentWhite(h1)
    if h3.checkAdjacentWhite(h2)
    if matchCornerBrandAnimal(h5, h4, "Horse", "Dunhill")
    if matchMiddleBrandAnimal(h2, h3, h4, "Blend", "Cats")
    if matchMiddleBrandAnimal(h3, h4, h5, "Blend", "Cats")
  } yield Seq(h1, h2, h3, h4, h5)

  def matchMiddleBrandAnimal(home1: House, home2: House, home3: House, brand: String, animal: String) =
    (home1.animal == animal || home2.brand != brand || home3.animal == animal) &&
      (home1.brand == brand || home2.animal != animal || home3.brand == brand)

  def matchCornerBrandAnimal(corner: House, inner: House, animal: String, brand: String) =
    (corner.brand != brand || inner.animal == animal) && (corner.animal == animal || inner.brand != brand)

  def housesLeftOver(pickedHouses: House*): List[House] = {
    possibleMembers.filter(house => pickedHouses.forall(_.totalUnEqual(house)))
  }

  class House(val nationality: String, val color: String, val beverage: String, val animal: String, val brand: String) {
    override def toString = {
      f"$nationality%10s, ${color + ", "}%-8s$beverage,\t$animal,\t$brand."
    }

    def totalUnEqual(home2: House) =
      this.animal != home2.animal &&
        this.beverage != home2.beverage &&
        this.brand != home2.brand &&
        this.color != home2.color &&
        this.nationality != home2.nationality

    //** Checks if the this green house is next to the other white house*/
    def checkAdjacentWhite(home2: House) = (this.color == "Green") == (home2.color == "White") // #5
  }

  { // Main program
    val beest = "Zebra"
    members.flatMap(p => p.filter(p => p.animal == beest)).
      foreach(s => println(s"The ${s.nationality} is the owner of the ${beest.toLowerCase}."))

    println(s"The ${members.size} solution(s) are:")
    members.foreach(solution => solution.zipWithIndex.foreach(h => println(s"House ${h._2 + 1} ${h._1}")))
  }
} // loc 58


var CONTENT = Hash(
            :House       => nil,
            :Nationality => [:English, :Swedish, :Danish, :Norwegian, :German],
            :Colour      => [:Red, :Green, :White, :Blue, :Yellow],
            :Pet         => [:Dog, :Birds, :Cats, :Horse, :Zebra],
            :Drink       => [:Tea, :Coffee, :Milk, :Beer, :Water],
            :Smoke       => [:PallMall, :Dunhill, :BlueMaster, :Prince, :Blend]
)

func adjacent(n,i,g,e) {
  (0..3).any {|x| (n[x]==i && g[x+1]==e) || (n[x+1]==i && g[x]==e) }
}

func leftof(n,i,g,e) {
  (0..3).any {|x| n[x]==i && g[x+1]==e }
}

func coincident(n,i,g,e) {
  n.indices.any {|x| n[x]==i && g[x]==e }
}

func solve {
  CONTENT{:Nationality}.permutations{|*nation|
    nation.first == :Norwegian ->
      && CONTENT{:Colour}.permutations {|*colour|
          leftof(colour,:Green,colour,:White) ->
       && coincident(nation,:English,colour,:Red) ->
       && adjacent(nation,:Norwegian,colour,:Blue) ->
       && CONTENT{:Pet}.permutations {|*pet|
             coincident(nation,:Swedish,pet,:Dog) ->
          && CONTENT{:Drink}.permutations {|*drink|
               drink[2] == :Milk ->
            && coincident(nation,:Danish,drink,:Tea) ->
            && coincident(colour,:Green,drink,:Coffee) ->
            && CONTENT{:Smoke}.permutations {|*smoke|
                coincident(smoke,:PallMall,pet,:Birds) ->
             && coincident(smoke,:Dunhill,colour,:Yellow) ->
             && coincident(smoke,:BlueMaster,drink,:Beer) ->
             && coincident(smoke,:Prince,nation,:German) ->
             && adjacent(smoke,:Blend,pet,:Cats) ->
             && adjacent(smoke,:Blend,drink,:Water) ->
             && adjacent(smoke,:Dunhill,pet,:Horse) ->
             && return [nation,colour,pet,drink,smoke]
} } } } } }

var res = solve();
var keys = [:House, :Nationality, :Colour, :Pet, :Drink, :Smoke]
var width = keys.map{ .len }
var fmt = width.map{|w| "%-#{w+2}s" }.join(" ")
say "The Zebra is owned by the man who is #{res[0][res[2].first_index(:Zebra)]}\n"
say (fmt % keys..., "\n", fmt % width.map{|w| "-"*w }...)
res[0].indices.map{|i| res.map{|a| a[i] }}.each_kv {|k,v| say fmt%(k,v...) }


(* Attributes and values *)
val str_attributes = Vector.fromList ["Color",    "Nation",  "Drink", "Pet",        "Smoke"]
val str_colors     = Vector.fromList ["Red",      "Green",   "White", "Yellow",     "Blue"]
val str_nations    = Vector.fromList ["English",  "Swede",   "Dane",  "German",     "Norwegian"]
val str_drinks     = Vector.fromList ["Tea",      "Coffee",  "Milk",  "Beer",       "Water"]
val str_pets       = Vector.fromList ["Dog",      "Birds",   "Cats",  "Horse",      "Zebra"]
val str_smokes     = Vector.fromList ["PallMall", "Dunhill", "Blend", "BlueMaster", "Prince"]

val (Color, Nation, Drink, Pet, Smoke)             = (0, 1, 2, 3, 4)	(* Attributes *)
val (Red, Green, White, Yellow, Blue)              = (0, 1, 2, 3, 4)	(* Color      *)
val (English, Swede, Dane, German, Norwegian)      = (0, 1, 2, 3, 4)	(* Nation     *)
val (Tea, Coffee, Milk, Beer, Water)               = (0, 1, 2, 3, 4)	(* Drink      *)
val (Dog, Birds, Cats, Horse, Zebra)               = (0, 1, 2, 3, 4)	(* Pet        *)
val (PallMall, Dunhill, Blend, BlueMaster, Prince) = (0, 1, 2, 3, 4)	(* Smoke      *)

type attr    = int
type value   = int
type houseno = int

(* Rules *)
datatype rule =
	  AttrPairRule of (attr * value) * (attr * value)
	| NextToRule   of (attr * value) * (attr * value)
	| LeftOfRule   of (attr * value) * (attr * value)

(* Conditions *)
val rules = [
AttrPairRule ((Nation, English), (Color, Red)),		(* #02 *)
AttrPairRule ((Nation, Swede), (Pet, Dog)),		(* #03 *)
AttrPairRule ((Nation, Dane), (Drink, Tea)), 		(* #04 *)
LeftOfRule   ((Color, Green), (Color, White)),		(* #05 *)
AttrPairRule ((Color, Green), (Drink, Coffee)),		(* #06 *)
AttrPairRule ((Smoke, PallMall), (Pet, Birds)),		(* #07 *)
AttrPairRule ((Smoke, Dunhill), (Color, Yellow)),	(* #08 *)
NextToRule   ((Smoke, Blend), (Pet, Cats)),		(* #11 *)
NextToRule   ((Smoke, Dunhill), (Pet, Horse)),		(* #12 *)
AttrPairRule ((Smoke, BlueMaster), (Drink, Beer)),	(* #13 *)
AttrPairRule ((Nation, German), (Smoke, Prince)),	(* #14 *)
NextToRule   ((Nation, Norwegian), (Color, Blue)),	(* #15 *)
NextToRule   ((Smoke, Blend), (Drink, Water))]		(* #16 *)

type house = value option * value option * value option * value option * value option

fun houseval ((a, b, c, d, e) : house, 0 : attr) = a
  | houseval ((a, b, c, d, e) : house, 1 : attr) = b
  | houseval ((a, b, c, d, e) : house, 2 : attr) = c
  | houseval ((a, b, c, d, e) : house, 3 : attr) = d
  | houseval ((a, b, c, d, e) : house, 4 : attr) = e
  | houseval _ = raise Domain

fun sethouseval ((a, b, c, d, e) : house, 0 : attr, a2 : value option) = (a2, b,  c,  d,  e )
  | sethouseval ((a, b, c, d, e) : house, 1 : attr, b2 : value option) = (a,  b2, c,  d,  e )
  | sethouseval ((a, b, c, d, e) : house, 2 : attr, c2 : value option) = (a,  b,  c2, d,  e )
  | sethouseval ((a, b, c, d, e) : house, 3 : attr, d2 : value option) = (a,  b,  c,  d2, e )
  | sethouseval ((a, b, c, d, e) : house, 4 : attr, e2 : value option) = (a,  b,  c,  d,  e2)
  | sethouseval _ = raise Domain

fun getHouseVal houses (no, attr) = houseval (Array.sub (houses, no), attr)
fun setHouseVal houses (no, attr, newval) =
	Array.update (houses, no, sethouseval (Array.sub (houses, no), attr, newval))

fun match (house, (rule_attr, rule_val)) =
	let
	  val value = houseval (house, rule_attr)
	in
	  isSome value andalso valOf value = rule_val
	end

fun matchNo houses (no, rule) =
	 match (Array.sub (houses, no), rule)

fun compare (house1, house2, ((rule_attr1, rule_val1), (rule_attr2, rule_val2))) =
	let
	  val val1 = houseval (house1, rule_attr1)
	  val val2 = houseval (house2, rule_attr2)
	in
	  if isSome val1 andalso isSome val2
	  then (valOf val1 = rule_val1 andalso valOf val2 <> rule_val2)
	         orelse
	       (valOf val1 <> rule_val1 andalso valOf val2 = rule_val2)
	  else false
	end

fun compareNo houses (no1, no2, rulepair) =
	compare (Array.sub (houses, no1), Array.sub (houses, no2), rulepair)

fun invalid houses no (AttrPairRule rulepair) =
	compareNo houses (no, no, rulepair)

  | invalid houses no (NextToRule rulepair) =
  	(if no > 0
	 then compareNo houses (no, no-1, rulepair)
	 else true)
	andalso
	(if no < 4
	 then compareNo houses (no, no+1, rulepair)
	 else true)

  | invalid houses no (LeftOfRule rulepair) =
  	if no > 0
	then compareNo houses (no-1, no, rulepair)
	else matchNo houses (no, #1rulepair)

(*
 * val checkRulesForNo : house vector -> houseno -> bool
 * Check all rules for a house;
 * Returns true, when one rule was invalid.
 *)
fun checkRulesForNo (houses : house array) no =
	let
	  exception RuleError
	in
	  (map (fn rule => if invalid houses no rule then raise RuleError else ()) rules;
	   false)
	  handle RuleError => true
	end

(*
 * val checkAll : house vector -> bool
 * Check all rules;
 * return true if everything is ok.
 *)
fun checkAll (houses : house array) =
	let
	  exception RuleError
	in
	  (map (fn no => if checkRulesForNo houses no then raise RuleError else ()) [0,1,2,3,4];
	   true)
	  handle RuleError => false
	end

(*
 *
 * House printing for debugging
 *
 *)

fun valToString (0, SOME a) = Vector.sub (str_colors,  a)
  | valToString (1, SOME b) = Vector.sub (str_nations, b)
  | valToString (2, SOME c) = Vector.sub (str_drinks,  c)
  | valToString (3, SOME d) = Vector.sub (str_pets,    d)
  | valToString (4, SOME e) = Vector.sub (str_smokes,  e)
  | valToString _ = "-"

(*
 * Note:
 * Format needs SML NJ
 *)
fun printHouse no ((a, b, c, d, e) : house) =
	(
	  print (Format.format "%12d" [Format.LEFT (12, Format.INT no)]);
	  print (Format.format "%12s%12s%12s%12s%12s"
	  	(map (fn (x, y) => Format.LEFT (12, Format.STR (valToString (x, y))))
			[(0,a), (1,b), (2,c), (3,d), (4,e)]));
	  print ("\n")
	)

fun printHouses houses =
	(
	  print (Format.format "%12s" [Format.LEFT (12, Format.STR "House")]);
	  Vector.map (fn a => print (Format.format "%12s" [Format.LEFT (12, Format.STR a)]))
	  	str_attributes;
	  print "\n";
	  Array.foldli (fn (no, house, _) => printHouse no house) () houses
	)

(*
 *
 * Solving
 *
 *)

exception SolutionFound

fun search (houses : house array, used : bool Array2.array) (no : houseno, attr : attr) =
	let
	  val i = ref 0
	  val (nextno, nextattr) = if attr < 4 then (no, attr + 1) else (no + 1, 0)
	in
	  if isSome (getHouseVal houses (no, attr))
	  then
	  (
	    search (houses, used) (nextno, nextattr)
	  )
	  else
	  (
	    while (!i < 5)
	    do
	    (
	      if Array2.sub (used, attr, !i) then ()
	      else
	      (
	          Array2.update (used, attr, !i, true);
	          setHouseVal houses (no, attr, SOME (!i));

	          if checkAll houses then
	          (
	            if no = 4 andalso attr = 4
	            then raise SolutionFound
	            else search (houses, used) (nextno, nextattr)
	          )
	          else ();
	          Array2.update (used, attr, !i, false)
	      ); (* else *)
	      i := !i + 1
	    ); (* do *)
	    setHouseVal houses (no, attr, NONE)
	  ) (* else *)
	end

fun init () =
	let
	  val unknown : house = (NONE, NONE, NONE, NONE, NONE)
	  val houses  = Array.fromList [unknown, unknown, unknown, unknown, unknown]
	  val used    = Array2.array (5, 5, false)
	in
	  (houses, used)
	end

fun solve () =
	let
	  val (houses, used) = init()
	in
	  setHouseVal houses (2, Drink, SOME Milk);		(* #09 *)
	  Array2.update (used, Drink, Milk, true);
	  setHouseVal houses (0, Nation, SOME Norwegian);	(* #10 *)
	  Array2.update (used, Nation, Norwegian, true);
	  (search (houses, used) (0, 0); NONE)
	  handle SolutionFound => SOME houses
	end

(*
 *
 * Execution
 *
 *)

fun main () = let
	  val solution = solve()
	in
	  if isSome solution
	  then printHouses (valOf solution)
	  else print "No solution found!\n"
	end


processor EinsteinSolver
  @: [{|{}|}]; // A list of possible relations, start with one relation with an empty tuple
  $ -> \(
    when <[](1..)> do
      def variableRange: $(1);
      @EinsteinSolver: [([email protected](1) join {|{by $variableRange...}|})];
      $(2..last) -> #
  \) -> !VOID

  sink isFact
    def fact: $;
    def parts: [$... -> {$}];
    @EinsteinSolver: [[email protected] -> \(
      def new: ($ matching {|$fact|});
      @: $;
      $parts... -> @: ([email protected] notMatching {| $ |});
      ($new union [email protected]) !
    \)];
  end isFact

  operator (a nextTo&{byField:, bMinusA:} b)
    data ES_temp__ <"1"> local
    @EinsteinSolver: [[email protected] -> \(
      def in: $;
      def temp: {| $... -> {$, ES_temp__: $(byField)::raw} |};
      def numbers: [$temp({ES_temp__:})... -> $.ES_temp__];
      $numbers... -> \(
        def aNumber: $;
        def bNumbers: [$bMinusA... -> $ + $aNumber];
        def new: ($temp matching {| {$a, ES_temp__: $aNumber} |});
        @: ($new union (($temp notMatching {| $a |}) notMatching {| {ES_temp__: $aNumber} |}));
        $numbers... -> \(<~ ?($bNumbers <[<=$>]>)> $! \) -> @: ([email protected] notMatching {| {$b, ES_temp__: $} |});
        ($in matching [email protected]) !
      \) !
    \)];
  end nextTo

  source solutions&{required:}
    templates resolve&{rows:}
      when <?($rows <=1>)?($::count <=1>)> do $ !
      when <?($::count <$rows..>)> do
        def in: $;
        def selected: [$...] -> $(1);
        ($in minus {|$selected|}) -> resolve&{rows: $rows} ! // Alternative solutions
        @: $;
        $selected... -> {$} -> @: ([email protected] notMatching {| $ |});
        [[email protected] -> resolve&{rows: $rows-1}] -> \(
            when <~=[]> do
              $... -> {| $..., $selected |} !
        \) !
    end resolve
    [[email protected] -> resolve&{rows: $required}] !
  end solutions
end EinsteinSolver

def numbers: [1..5 -> (no: $)];
def nationalities: [['Englishman', 'Swede', 'Dane', 'Norwegian', 'German']... -> (nationality:$)];
def colours: [['red', 'green', 'white', 'yellow', 'blue']... -> (colour:$)];
def pets: [['dog', 'birds', 'cats', 'horse', 'zebra']... -> (pet:$)];
def drinks: [['tea', 'coffee', 'milk', 'beer', 'water']... -> (drink:$)];
def smokes: [['Pall Mall', 'Dunhill', 'Blend', 'Blue Master', 'Prince']... -> (smoke: $)];

def solutions: [$numbers, $nationalities, $colours, $pets, $drinks, $smokes] -> \(
  def solver: $ -> EinsteinSolver;

  {nationality: 'Englishman', colour: 'red'} -> !solver::isFact
  {nationality: 'Swede', pet: 'dog'} -> !solver::isFact
  {nationality: 'Dane', drink: 'tea'} -> !solver::isFact
  ({colour: 'green'} solver::nextTo&{byField: :(no:), bMinusA: [1]} {colour: 'white'}) -> !VOID
  {drink: 'coffee', colour: 'green'} -> !solver::isFact
  {smoke: 'Pall Mall', pet: 'birds'} -> !solver::isFact
  {colour: 'yellow', smoke: 'Dunhill'} -> !solver::isFact
  {no: 3, drink: 'milk'} -> !solver::isFact
  {nationality: 'Norwegian', no: 1} -> !solver::isFact
  ({smoke: 'Blend'} solver::nextTo&{byField: :(no:), bMinusA: [-1, 1]} {pet: 'cats'}) -> !VOID
  ({smoke: 'Dunhill'} solver::nextTo&{byField: :(no:), bMinusA: [-1, 1]} {pet: 'horse'}) -> !VOID
  {smoke: 'Blue Master', drink: 'beer'} -> !solver::isFact
  {nationality: 'German', smoke: 'Prince'} -> !solver::isFact
  ({nationality: 'Norwegian'} solver::nextTo&{byField: :(no:), bMinusA: [-1, 1]} {colour: 'blue'}) -> !VOID
  ({drink: 'water'} solver::nextTo&{byField: :(no:), bMinusA: [-1, 1]} {smoke: 'Blend'}) -> !VOID

  $solver::solutions&{required: 5}!
\);

$solutions... -> ($ matching {| {pet: 'zebra'} |}) ... -> 'The $.nationality; owns the zebra.

' -> !OUT::write

$solutions -> \[i]('Solution $i;:
$... -> '$;
';
'! \)... -> !OUT::write
'No more solutions
' -> !OUT::write


(use 'clj-figlet.core)
(println
  (render-to-string
    (load-flf "ftp://ftp.figlet.org/pub/figlet/fonts/contributed/larry3d.flf")
    "Clojure"))


package require struct::list

# Implements the constants by binding them directly into the named procedures.
# This is much faster than the alternatives!
proc initConstants {args} {
    global {}
    set remap {}
    foreach {class elems} {
	Number {One Two Three Four Five}
	Color {Red Green Blue White Yellow}
	Drink {Milk Coffee Water Beer Tea}
	Smoke {PallMall Dunhill Blend BlueMaster Prince}
	Pet {Dog Cat Horse Bird Zebra}
	Nation {British Swedish Danish Norwegian German}
    } {
	set i -1
	foreach e $elems {lappend remap "\$${class}($e)" [incr i]}
	set ($class) $elems
    }
    foreach procedure $args {
	proc $procedure [info args $procedure] \
	    [string map $remap [info body $procedure]]
    }
}

proc isPossible {number color drink smoke pet} {
    if {[llength $number] && [lindex $number $Nation(Norwegian)] != $Number(One)} {
	return false
    } elseif {[llength $color] && [lindex $color $Nation(British)] != $Color(Red)} {
	return false
    } elseif {[llength $drink] && [lindex $drink $Nation(Danish)] != $Drink(Tea)} {
	return false
    } elseif {[llength $smoke] && [lindex $smoke $Nation(German)] != $Smoke(Prince)} {
	return false
    } elseif {[llength $pet] && [lindex $pet $Nation(Swedish)] != $Pet(Dog)} {
	return false
    }

    if {!([llength $number] && [llength $color] && [llength $drink] && [llength $smoke] && [llength $pet])} {
	return true
    }

    for {set i 0} {$i < 5} {incr i} {
	if {[lindex $color $i] == $Color(Green) && [lindex $drink $i] != $Drink(Coffee)} {
	    return false
	} elseif {[lindex $smoke $i] == $Smoke(PallMall) && [lindex $pet $i] != $Pet(Bird)} {
	    return false
	} elseif {[lindex $color $i] == $Color(Yellow) && [lindex $smoke $i] != $Smoke(Dunhill)} {
	    return false
	} elseif {[lindex $number $i] == $Number(Three) && [lindex $drink $i] != $Drink(Milk)} {
	    return false
	} elseif {[lindex $smoke $i] == $Smoke(BlueMaster) && [lindex $drink $i] != $Drink(Beer)} {
	    return false
	} elseif {[lindex $color $i] == $Color(Blue) && [lindex $number $i] != $Number(Two)} {
	    return false
	}

	for {set j 0} {$j < 5} {incr j} {
	    if {[lindex $color $i] == $Color(Green) && [lindex $color $j] == $Color(White) && [lindex $number $j] - [lindex $number $i] != 1} {
		return false
	    }

	    set diff [expr {abs([lindex $number $i] - [lindex $number $j])}]
	    if {[lindex $smoke $i] == $Smoke(Blend) && [lindex $pet $j] == $Pet(Cat) && $diff != 1} {
		return false
	    } elseif {[lindex $pet $i] == $Pet(Horse) && [lindex $smoke $j] == $Smoke(Dunhill) && $diff != 1} {
		return false
	    } elseif {[lindex $smoke $i] == $Smoke(Blend) && [lindex $drink $j] == $Drink(Water) && $diff != 1} {
		return false
	    }
	}
    }

    return true
}

proc showRow {t data} {
    upvar #0 ($t) elems
    puts [format "%6s: %12s%12s%12s%12s%12s" $t \
	      [lindex $elems [lindex $data 0]] \
	      [lindex $elems [lindex $data 1]] \
	      [lindex $elems [lindex $data 2]] \
	      [lindex $elems [lindex $data 3]] \
	      [lindex $elems [lindex $data 4]]]
}

proc main {} {
    set perms [struct::list permutations {0 1 2 3 4}]
    foreach number $perms {
	if {![isPossible $number {} {} {} {}]} continue
	foreach color $perms {
	    if {![isPossible $number $color {} {} {}]} continue
	    foreach drink $perms {
		if {![isPossible $number $color $drink {} {}]} continue
		foreach smoke $perms {
		    if {![isPossible $number $color $drink $smoke {}]} continue
		    foreach pet $perms {
			if {[isPossible $number $color $drink $smoke $pet]} {
			    puts "Found a solution:"
			    showRow Nation {0 1 2 3 4}
			    showRow Number $number
			    showRow Color  $color
			    showRow Drink  $drink
			    showRow Smoke  $smoke
			    showRow Pet    $pet
			    puts ""
			}
		    }
		}
	    }
	}
    }
}

initConstants isPossible
main