in reply to Re^3: My first cpan module - App::ForKids::LogicalPuzzleGenerator
in thread My first cpan module - App::ForKids::LogicalPuzzleGenerator
That was fun :) Thanks!
#!/usr/bin/perl -l # http://perlmonks.org/?node_id=1209931 use strict; use warnings; # columns # 0 house number left to right # 1 colors # 2 pets (only 4 mentioned, 5th called 'spot') # 3 drink (only 4 mentioned, 5th called 'drink') # 4 nationality # 5 smokes $_ = <<END; # starting configuration 1 blue,red,green,ivory,yellow dog,snails,fox,horse,spot coffee,tea,mil +k,orangejuice,drink Englishman,Spaniard,Ukrainian,Japanese,Norwegian +OldGold,Kools,Chesterfields,LuckyStrike,Parliaments 2 blue,red,green,ivory,yellow dog,snails,fox,horse,spot coffee,tea,mil +k,orangejuice,drink Englishman,Spaniard,Ukrainian,Japanese,Norwegian +OldGold,Kools,Chesterfields,LuckyStrike,Parliaments 3 blue,red,green,ivory,yellow dog,snails,fox,horse,spot coffee,tea,mil +k,orangejuice,drink Englishman,Spaniard,Ukrainian,Japanese,Norwegian +OldGold,Kools,Chesterfields,LuckyStrike,Parliaments 4 blue,red,green,ivory,yellow dog,snails,fox,horse,spot coffee,tea,mil +k,orangejuice,drink Englishman,Spaniard,Ukrainian,Japanese,Norwegian +OldGold,Kools,Chesterfields,LuckyStrike,Parliaments 5 blue,red,green,ivory,yellow dog,snails,fox,horse,spot coffee,tea,mil +k,orangejuice,drink Englishman,Spaniard,Ukrainian,Japanese,Norwegian +OldGold,Kools,Chesterfields,LuckyStrike,Parliaments END my @stack = $_; while( $_ = pop @stack ) { my $prev; do { #print; $prev = $_; # The Englishman lives in the red house. s/ \K\S*red\S*(?= (\S+ ){2}Englishman )/red/; s/ red (\S+ ){2}\K\S*Englishman\S*/Englishman/; / red .* (Norwegian|Spaniard|Japanese|Ukrainian) / and next; / (blue|ivory|green|yellow) .* Englishman / and next; # The Spaniard owns the dog. s/ \K\S*dog\S*(?= \S+ Spaniard )/dog/; s/ dog \S+ \K\S*Spaniard\S*/Spaniard/; / dog .* (Norwegian|Japanese|Englishman|Ukrainian) / and next; / (horse|snails|fox|spot) .* Spaniard / and next; # Coffee is drunk in the green house. s/ green \S+ \K\S*coffee\S*/coffee/; s/ \K\S*green\S*(?= \S+ coffee )/green/; / green .* (drink|orangejuice|milk|tea) / and next; / (red|blue|ivory|yellow) .* coffee / and next; # The Ukrainian drinks tea. s/ \K\S*tea\S*(?= Ukrainian )/tea/; s/ tea \K\S*Ukrainian\S*/Ukrainian/; / tea (Norwegian|Spaniard|Japanese|Englishman) / and next; / (drink|orangejuice|milk|coffee) Ukrainian / and next; # The green house is immediately to the right of the ivory house. s/1 \K(green,|,green)//; s/5 .*\K(ivory,|,ivory)//; s/ ivory .*\n\d \K\S*green\S*/green/; s/ \K\S*ivory\S*(?= .*\n.* green )/ivory/; / ivory (.*\n){2,}.* green / and next; / green (.*\n)+.* ivory / and next; # The Old Gold smoker owns snails. s/ \K\S*snails\S*(?= (\S+ ){2}OldGold\s)/snails/; s/ snails (\S+ ){2}\K\S*OldGold\S*/OldGold/; / snails .* (LuckyStrike|Parliaments|Chesterfields|Kools)\s/ and n +ext; / (dog|fox|house|spot) .* OldGold\s/ and next; # Kools are smoked in the yellow house. s/ yellow (\S+ ){3}\K\S*Kools\S*/Kools/; s/ \K\S*yellow\S*(?= (\S+ ){3}Kools\s)/yellow/; / yellow ,* (LuckyStrike|Parliaments|Chesterfields|Kools)\s/ and n +ext; / (red|blue|ivory|green) .* Kools\s/ and next; # Milk is drunk in the middle house. s/3 (\S+ ){2}\K\S*milk\S*/milk/; # The Norwegian lives in the first house. s/1 (\S+ ){3}\K\S*Norwegian\S*/Norwegian/; # The man who smokes Chesterfields lives in the house next to the man +with the fox. s/1 .* fox .*\n(\S+ ){5}\K\S*Chesterfields\S*/Chesterfields/; s/ \K\S*fox\S*(?= .*\n5 .* Chesterfields\n)/fox/; s/ (dog,horse,snails,spot) .*\n.* Chesterfields\n.* \K\S*fox\S*/fo +x/; s/ \K\S*fox\s*(?= .*\n.* Chesterfields\n.* (dog,horse,snails,spot) + )/fox/; / fox .* Chesterfields\s/ and next; / fox (.*\n){2,}.* Chesterfields\s/ and next; / Chesterfields\n(.*\n)+.* fox / and next; # Kools are smoked in the house next to the house where the horse is k +ept. s/1 .* Kools\n(\S+ ){2}\K\S*horse\S*/horse/; s/ \K\S*horse\S*(?= .*\n5 .* Kools\n)/horse/; / horse .* Kools\s/ and next; / horse (.*\n){2,}.* Kools\s/ and next; / Kools\n(.*\n)+.* horse / and next; # The Lucky Strike smoker drinks orange juice. s/ orangejuice \S+ \K\S*LuckyStrike\S*/LuckyStrike/; s/ \K\S*orangejuice\S*(?= \S+ LuckyStrike\s)/orangejuice/; / orangejuice .* (OldGold|Parliaments|Chesterfields|Kools)\s/ and +next; / (drink|milk|coffee|tea) .* .LuckyStrike\s/ and next; # The Japanese smokes Parliaments. s/ Japanese \K\S*Parliaments\S*/Parliaments/; s/ \K\S*Japanese\S*(?= Parliaments\s)/Japanese/; / Japanese (OldGold|LuckyStrike|Chesterfields|Kools)\s/ and next; / (Norwegian|Spaniard|Englishman|Ukrainian) Parliaments\s/ and nex +t; # The Norwegian lives next to the blue house. s/1 .* Norwegian .*\n\d \K\S+/blue/; s/ \K\S*blue\s*(?= .*\n5 .* Norwegian .*\n)/blue/; / blue .* Norwegian / and next; / blue (.*\n)+.* Norwegian / and next; / Norwegian (.*\n){2,}.* blue / and next; for my $col (1 .. tr/ // / tr/\n// ) # for each column { for my $cell ( /^(?:\S+ ){$col}(\w+)\s/gm ) # find each single c +ell { s/^(?:\S+ ){$col}(?:\K$cell,|\S+\K,$cell\b)//gm; # delete in o +ther rows } } } until $_ eq $prev; if( /\S+,\S+/ ) # if some cell has a comma, fork (sort of) { push @stack, $` . $_ . $' for split /,/, $&; } else { print "Solution:\n\n$_"; exit; } }
Outputs:
Solution: 1 yellow fox drink Norwegian Kools 2 blue horse tea Ukrainian Chesterfields 3 red snails milk Englishman OldGold 4 ivory dog orangejuice Spaniard LuckyStrike 5 green spot coffee Japanese Parliaments
The s/// are logical cell fillers.
The // and next are validation.
Update
s/spot/zebra/; s/drink/water/;
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^5: My first cpan module - App::ForKids::LogicalPuzzleGenerator
by LanX (Saint) on Feb 26, 2018 at 19:22 UTC | |
by tybalt89 (Monsignor) on Feb 27, 2018 at 00:51 UTC | |
by LanX (Saint) on Feb 27, 2018 at 09:33 UTC | |
by tybalt89 (Monsignor) on Feb 27, 2018 at 10:24 UTC | |
|
Re^5: My first cpan module - App::ForKids::LogicalPuzzleGenerator
by LanX (Saint) on Feb 26, 2018 at 01:15 UTC |