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"  
};

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 {		
		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;
		}
	};
}





setprops (
	
	
	'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) ]
);


pair qw( AEnglisk red );
pair qw( Svensk dog );
pair qw( Danske tea );
pair qw( green white 1 );	
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 );	
pair qw( Deutsch prince );
pair qw( Norske blue -1 1 );
pair qw( water blend -1 1 );

$solve->();