Talk:Passtune

turncount

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)

perl solver

Here is something you may find interesting.

#!/usr/bin/env 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();

--Doran (talk) 02:40, 24 March 2020 (UTC)