Difference between revisions of "Talk:Passtune"
Jump to navigation
Jump to search
(Created page with 'If I recall well, playing passtune doesn't increase turn count, am I right? If so, I suppose it should be mentioned there. --~~~~') |
|||
Line 1: | Line 1: | ||
If I recall well, playing passtune doesn't increase turn count, am I right? If so, I suppose it should be mentioned there. | If I recall well, playing passtune doesn't increase turn count, am I right? If so, I suppose it should be mentioned there. | ||
--[[User:Lukky513|Lukky513]] 14:19, 4 July 2009 (UTC) | --[[User:Lukky513|Lukky513]] 14:19, 4 July 2009 (UTC) | ||
+ | |||
+ | Here is something you may find interesting. | ||
+ | <pre> | ||
+ | #!/usr/bin/perl | ||
+ | |||
+ | # This code is hereby released into the public domain. | ||
+ | # Use as you wish, at your own risk. | ||
+ | |||
+ | use strict 'vars'; | ||
+ | |||
+ | my $colors = 7; | ||
+ | my $positions = 5; | ||
+ | |||
+ | sub randomtune() { | ||
+ | my $ret; | ||
+ | my $i; | ||
+ | |||
+ | for ($i = 0; $i < $positions; $i++) { | ||
+ | $ret .= chr(65 + int(rand() * 7)); | ||
+ | } | ||
+ | return $ret; | ||
+ | } | ||
+ | |||
+ | sub score($$) { | ||
+ | my ($true, $guess) = @_; | ||
+ | my $gears = 0; | ||
+ | my $tumblers = 0; | ||
+ | |||
+ | my @true = split //, $true; | ||
+ | my @guess = split //, $guess; | ||
+ | |||
+ | for (my $i = 0; $i < $positions; $i++) { | ||
+ | if ($true[$i] eq $guess[$i]) { | ||
+ | $gears++; | ||
+ | $true[$i] = $guess[$i] = 'X'; | ||
+ | } | ||
+ | } | ||
+ | |||
+ | for (my $i = 0; $i < $positions; $i++) { | ||
+ | if ($guess[$i] ne 'X') { | ||
+ | for (my $j = 0; $j < $positions; $j++) { | ||
+ | if ($true[$j] eq $guess[$i]) { | ||
+ | $tumblers++; | ||
+ | $true[$j] = $guess[$i] = 'X'; | ||
+ | last; | ||
+ | } | ||
+ | } | ||
+ | } | ||
+ | } | ||
+ | |||
+ | return ($gears, $tumblers); | ||
+ | } | ||
+ | |||
+ | my %possible; | ||
+ | sub initpossible() { | ||
+ | for (my $i = 0; $i < $colors ** $positions; $i++) { | ||
+ | my $possible = ""; | ||
+ | my $j = $i; | ||
+ | for (my $k = 0; $k < $positions; $k++) { | ||
+ | $possible .= chr(65 + ($j % $colors)); | ||
+ | $j /= $colors; | ||
+ | } | ||
+ | $possible{$possible} = 1; | ||
+ | } | ||
+ | } | ||
+ | |||
+ | sub test() { | ||
+ | initpossible(); | ||
+ | my $tru = randomtune(); | ||
+ | |||
+ | while (1) { | ||
+ | my @keys = keys(%possible); | ||
+ | my $nkeys = $#keys + 1; | ||
+ | |||
+ | print "$nkeys\n"; | ||
+ | my $i = int(rand() * $nkeys); | ||
+ | my $gue = $keys[$i]; | ||
+ | print "$tru\n$gue\n"; | ||
+ | my ($gea, $tum) = score($tru, $gue); | ||
+ | print "$gea $tum\n"; | ||
+ | print "\n"; | ||
+ | |||
+ | if ($gea != $positions) { | ||
+ | delete $possible{$gue}; | ||
+ | for (my $j = 0; $j < $nkeys; $j++) { | ||
+ | if ($j != $i) { | ||
+ | my ($g, $t) = score($gue, $keys[$j]); | ||
+ | if ($g != $gea || $t != $tum) { | ||
+ | delete $possible{$keys[$j]}; | ||
+ | } | ||
+ | } | ||
+ | } | ||
+ | } | ||
+ | else { | ||
+ | last; | ||
+ | } | ||
+ | } | ||
+ | } | ||
+ | |||
+ | sub solver() { | ||
+ | initpossible(); | ||
+ | |||
+ | while (1) { | ||
+ | my @keys = keys(%possible); | ||
+ | my $nkeys = $#keys + 1; | ||
+ | |||
+ | print "$nkeys\n"; | ||
+ | my $i = int(rand() * $nkeys); | ||
+ | my $gue = $keys[$i]; | ||
+ | |||
+ | print "REMAIN: $nkeys\n"; | ||
+ | print "GUESS : $gue\n"; | ||
+ | |||
+ | my $input = readline(STDIN); | ||
+ | $input =~ s/[\x0a\x0d]//g; | ||
+ | my ($gea, $tum) = split / /, $input; | ||
+ | |||
+ | if ($gea != $positions) { | ||
+ | delete $possible{$gue}; | ||
+ | for (my $j = 0; $j < $nkeys; $j++) { | ||
+ | if ($j != $i) { | ||
+ | my ($g, $t) = score($gue, $keys[$j]); | ||
+ | if ($g != $gea || $t != $tum) { | ||
+ | delete $possible{$keys[$j]}; | ||
+ | } | ||
+ | } | ||
+ | } | ||
+ | } | ||
+ | else { | ||
+ | last; | ||
+ | } | ||
+ | } | ||
+ | } | ||
+ | |||
+ | #test(); | ||
+ | solver(); | ||
+ | </pre> | ||
+ | --[[User:Doran|Doran]] ([[User talk:Doran|talk]]) 02:40, 24 March 2020 (UTC) |
Revision as of 02:40, 24 March 2020
If I recall well, playing passtune doesn't increase turn count, am I right? If so, I suppose it should be mentioned there. --Lukky513 14:19, 4 July 2009 (UTC)
Here is something you may find interesting.
#!/usr/bin/perl # This code is hereby released into the public domain. # Use as you wish, at your own risk. use strict 'vars'; my $colors = 7; my $positions = 5; sub randomtune() { my $ret; my $i; for ($i = 0; $i < $positions; $i++) { $ret .= chr(65 + int(rand() * 7)); } return $ret; } sub score($$) { my ($true, $guess) = @_; my $gears = 0; my $tumblers = 0; my @true = split //, $true; my @guess = split //, $guess; for (my $i = 0; $i < $positions; $i++) { if ($true[$i] eq $guess[$i]) { $gears++; $true[$i] = $guess[$i] = 'X'; } } for (my $i = 0; $i < $positions; $i++) { if ($guess[$i] ne 'X') { for (my $j = 0; $j < $positions; $j++) { if ($true[$j] eq $guess[$i]) { $tumblers++; $true[$j] = $guess[$i] = 'X'; last; } } } } return ($gears, $tumblers); } my %possible; sub initpossible() { for (my $i = 0; $i < $colors ** $positions; $i++) { my $possible = ""; my $j = $i; for (my $k = 0; $k < $positions; $k++) { $possible .= chr(65 + ($j % $colors)); $j /= $colors; } $possible{$possible} = 1; } } sub test() { initpossible(); my $tru = randomtune(); while (1) { my @keys = keys(%possible); my $nkeys = $#keys + 1; print "$nkeys\n"; my $i = int(rand() * $nkeys); my $gue = $keys[$i]; print "$tru\n$gue\n"; my ($gea, $tum) = score($tru, $gue); print "$gea $tum\n"; print "\n"; if ($gea != $positions) { delete $possible{$gue}; for (my $j = 0; $j < $nkeys; $j++) { if ($j != $i) { my ($g, $t) = score($gue, $keys[$j]); if ($g != $gea || $t != $tum) { delete $possible{$keys[$j]}; } } } } else { last; } } } sub solver() { initpossible(); while (1) { my @keys = keys(%possible); my $nkeys = $#keys + 1; print "$nkeys\n"; my $i = int(rand() * $nkeys); my $gue = $keys[$i]; print "REMAIN: $nkeys\n"; print "GUESS : $gue\n"; my $input = readline(STDIN); $input =~ s/[\x0a\x0d]//g; my ($gea, $tum) = split / /, $input; if ($gea != $positions) { delete $possible{$gue}; for (my $j = 0; $j < $nkeys; $j++) { if ($j != $i) { my ($g, $t) = score($gue, $keys[$j]); if ($g != $gea || $t != $tum) { delete $possible{$keys[$j]}; } } } } else { last; } } } #test(); solver();