Commits

Shlomi Fish committed 2606764

Copied to all-in-a-row range solving.

  • Participants
  • Parent commits 08e0a9b

Comments (0)

Files changed (15)

black-hole-solitaire/all-in-a-row-c-solver/CMakeLists.txt

 # which point to directories outside the build tree to the install RPATH
 SET(CMAKE_INSTALL_RPATH_USE_LINK_PATH TRUE)
 
-SET (LIB_BASE "black_hole_solver")
+SET (LIB_BASE "all_in_a_row_solver")
 
-SET (BLACK_HOLE_SOLVER_MODULES "alloc.c" "${LIB_BASE}.c")
+SET (BLACK_HOLE_SOLVER_MODULES "alloc.c" "black_hole_solver.c")
 
 IF (${BHS_STATE_STORAGE} STREQUAL "BHS_STATE_STORAGE_INTERNAL_HASH")
 
 
 SET(AUTOGENERATED_CONFIG_H "config.h was auto-generated from config.h.in . Do not modify directly")
 
-SET (BHS_EXE "black-hole-solve")
+SET (BHS_EXE "all-in-a-row-solve")
 
 ADD_EXECUTABLE(
     "${BHS_EXE}"

black-hole-solitaire/all-in-a-row-range-solving/down-range-remote.pl

+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use LWP::UserAgent;
+
+my $ua = LWP::UserAgent->new;
+$ua->timeout(10_000);
+$ua->env_proxy;
+
+my $url = 'http://10.0.0.5:3000/id';
+
+my $remote_box = 'lap';
+my $remote_dir = "\$HOME/progs/games/black-hole-solitaire/trunk/black-hole-solitaire/range-check";
+
+sub fetch_id
+{
+    my $response = $ua->get($url);
+    
+    if ($response->is_success())
+    {
+        my $ret = $response->decoded_content();
+        chomp($ret);
+        return $ret;
+    }
+    else
+    {
+        die $response->status_line();
+    }
+}
+
+while ((my $id = fetch_id()) > 0)
+{
+    print "$id\n";
+    my $fn = "$id.rs";
+
+    my $cond = qx{ssh $remote_box 'cd $remote_dir ; if test -e $fn && ! test -z $fn ; then echo 1 ; else echo 0 ; fi'};
+    chomp($cond);
+
+    if ($cond)
+    {
+        die "$id.rs already exists.";
+    }
+    system(qq{make_pysol_freecell_board.py -F -t "$id" black_hole | }
+        .  qq{black-hole-solve --max-iters 4000000 - | }
+        .  qq{ssh $remote_box 'cat > $remote_dir/$fn'}
+    );
+}

black-hole-solitaire/all-in-a-row-range-solving/down-range.pl

+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use LWP::UserAgent;
+
+
+my $ua = LWP::UserAgent->new;
+$ua->timeout(10_000);
+$ua->env_proxy;
+
+my $url = 'http://10.0.0.5:3000/id';
+
+sub fetch_id
+{
+    my $response = $ua->get($url);
+    
+    if ($response->is_success())
+    {
+        my $ret = $response->decoded_content();
+        chomp($ret);
+        return $ret;
+    }
+    else
+    {
+        die $response->status_line();
+    }
+}
+
+while ((my $id = fetch_id()) > 0)
+{
+    print "$id\n";
+    my $fn = "$id.rs";
+
+    if (-e $fn && (! -z $fn))
+    {
+        die "$id.rs already exists.";
+    }
+    system(qq{make_pysol_freecell_board.py -F -t "$id" black_hole | }
+        .  qq{black-hole-solve --max-iters 4000000 - > "$fn"}
+    );
+}

black-hole-solitaire/all-in-a-row-range-solving/down_range.bash

+#!/bin/bash
+export PATH="$HOME/progs/games/black-hole-solitaire/trunk/black-hole-solitaire/c-solver/build/:$PATH"
+perl down-range.pl 2>&1 | tee -a "$$.black-hole.LOG"

black-hole-solitaire/all-in-a-row-range-solving/down_range_remote.bash

+#!/bin/bash
+export PATH="$HOME/progs/games/black-hole-solitaire/trunk/black-hole-solitaire/c-solver/build/:$PATH"
+perl down-range-remote.pl 2>&1 | tee -a "$$.black-hole.LOG"

black-hole-solitaire/all-in-a-row-range-solving/fill-empty-solutions.sh

+#!/bin/bash
+MAX_ITERS="40,000,000"
+START=1
+END="1,000,000"
+
+    (seq "${START//,/}" "${END//,/}") |
+    (
+        while read T ; do
+            FN="$T.rs"
+            if test '!' -e "$FN" || test -z "$FN" ; then
+                echo "$T"
+                make_pysol_freecell_board.py -F -t "$T" black_hole |
+                black-hole-solve --max-iters "${MAX_ITERS//,/}" - > "$FN"
+            fi
+        done
+    ) 2>&1 | tee -a black_hole_fill_empty_LOG

black-hole-solitaire/all-in-a-row-range-solving/find-intractables.vala

+class Demo.HelloWorld : GLib.Object {
+
+    public static int main(string[] args)
+    {
+        try
+        {
+            for (int deal = 1; deal <= 1000000 ; deal++)
+            {
+                if (deal % 1000 == 0)
+                {
+                    stderr.printf("Reached %d\n", deal);
+                }
+                string fn = deal.to_string() + ".rs";
+                // stdout.printf("%s\n", fn);
+                
+                var file = File.new_for_path(fn);
+
+                if (file.query_exists(null))
+                {
+                    var in_stream = new DataInputStream (file.read (null));
+                    string line = in_stream.read_line(null,null);
+
+                    if (line != null)
+                    {
+                        if (/^Intract/.match(line))
+                        {
+                            stdout.printf("%s is intractable.\n", fn);
+                        }
+                    }
+                    else
+                    {
+                        stdout.printf("%s is empty.\n", fn);
+                    }
+                }
+                else
+                {
+                    stdout.printf("%s is missing.\n", fn);
+                }
+            }
+        }
+        catch (Error e) 
+        {
+            error ("%s", e.message);
+        }
+
+        return 0;
+    }
+}

black-hole-solitaire/all-in-a-row-range-solving/id-serve

+#!/usr/bin/perl
+
+use Dancer;
+use IO::All;
+
+my ($id, $end_at) = io->file("params.txt")->chomp->getlines();
+
+get '/id' => sub {
+    content_type 'text/plain';
+    if ($id == $end_at)
+    {
+        return "-1\n";
+    }
+    else
+    {
+        return (($id--)."\n");
+    }
+};
+
+dance;
+

black-hole-solitaire/all-in-a-row-range-solving/new-with-locked-files-and-quota/bhs.lock

Empty file added.

black-hole-solitaire/all-in-a-row-range-solving/new-with-locked-files-and-quota/bhs.params.good.txt

+116157 300000

black-hole-solitaire/all-in-a-row-range-solving/new-with-locked-files-and-quota/down-range.pl

+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+my @next_ids;
+
+my $QUOTA = 20;
+
+sub fetch_id
+{
+    if (! @next_ids)
+    {
+        my $line = qx[./get-quota $QUOTA];
+        chomp($line);
+        my ($start, $finish) = split(/\s+/, $line);
+        @next_ids = ($start .. $finish);
+    }
+    return shift(@next_ids);
+}
+
+while ((my $id = fetch_id()) > 0)
+{
+    print "$id\n";
+    my $fn = "$id.rs";
+
+    if (-e $fn && (! -z $fn))
+    {
+        die "$id.rs already exists.";
+    }
+    system(qq{make_pysol_freecell_board.py -F -t "$id" black_hole | }
+        .  qq{black-hole-solve --max-iters 4000000 - > "$fn"}
+    );
+}

black-hole-solitaire/all-in-a-row-range-solving/new-with-locked-files-and-quota/get-quota

+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Fcntl ':flock';
+
+my $quota = shift(@ARGV);
+
+open my $lock_fh, "<", "bhs.lock";
+flock($lock_fh, LOCK_EX());
+
+my ($start, $max);
+{
+open my $params_fh, "<", "bhs.params.txt";
+my $line = <$params_fh>;
+chomp($line);
+($start, $max) = split(/\s+/, $line);
+close($params_fh);
+}
+
+my $next = $start + $quota;
+
+if ($next > $max)
+{
+    $next = $max;
+}
+
+{
+open my $params_fh, ">", "bhs.params.txt";
+print {$params_fh} $next+1, " ", $max, "\n";
+close($params_fh);
+}
+
+flock($lock_fh, LOCK_UN());
+close($lock_fh);
+
+if ($start > $max)
+{
+    print "-1 -1\n";
+}
+else
+{
+    print "$start $next\n";
+}

black-hole-solitaire/all-in-a-row-range-solving/new-with-locked-files-and-quota/read-from-files-get-quota

+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Fcntl ':flock';
+
+my $IDS_FILENAME = "black-hole-solver-intractables-4.txt";
+my $quota = shift(@ARGV);
+
+open my $lock_fh, "<", "bhs.lock";
+flock($lock_fh, LOCK_EX());
+
+my ($next_id, @lines);
+
+{
+open my $params_fh, "<", $IDS_FILENAME;
+@lines = <$params_fh>;
+$next_id = shift(@lines);
+close($params_fh);
+}
+
+{
+open my $params_fh, ">", $IDS_FILENAME;
+print {$params_fh} @lines;
+close($params_fh);
+}
+
+flock($lock_fh, LOCK_UN());
+close($lock_fh);
+
+if (defined($next_id))
+{
+    chomp($next_id);
+    print "$next_id $next_id\n";
+}
+else
+{
+    print "-1 -1\n";
+}
+

black-hole-solitaire/all-in-a-row-range-solving/populate-summary-database.pl

+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Data::Dump;
+use DBI;
+use IO::All;
+use List::MoreUtils qw(zip part);
+
+my $DATABASE_FILE = "black_hole_solver.sqlite";
+
+my @ranks = ("A", 2 .. 9, qw(T J Q K));
+my %ranks_to_n = (map { $ranks[$_] => $_ } 0 .. $#ranks);
+
+my @suits = (qw(H C D S));
+my %suits_to_n = (map { $suits[$_] => $_ } 0 .. $#suits);
+
+my $card_re_str = '[' . join("", @ranks) . '][HSCD]';
+my $card_re = qr{$card_re_str};
+
+my %card_str_to_chr;
+
+foreach my $s (@suits)
+{
+    foreach my $r (@ranks)
+    {
+        # We start from 1 because '\0' may not be handled very well by
+        # certain languages.
+        $card_str_to_chr{$r.$s} =
+            chr(1 + $suits_to_n{$s} * 13 + $ranks_to_n{$r});
+    }
+}
+
+# dd(\%card_str_to_chr);
+
+my %stack_to_chr = (map { $_ => chr(1+$_) } (0 .. 16));
+
+my $should_init_db = (! -e $DATABASE_FILE);
+
+my $dbh = DBI->connect("dbi:SQLite:dbname=$DATABASE_FILE", "", "");
+
+my $runs_table = "bhs_runs";
+my $solutions_table = "bhs_solutions";
+if ($should_init_db)
+{
+    $dbh->do("CREATE TABLE $runs_table (idx INTEGER PRIMARY KEY, status CHAR(1), num_checked INTEGER, num_generated INTEGER)");
+    $dbh->do("CREATE TABLE $solutions_table (idx INTEGER PRIMARY KEY, solution VARCHAR(150))");
+}
+
+sub _slurp
+{
+    my $filename = shift;
+
+    open my $in, "<", $filename
+        or die "Cannot open '$filename' for slurping - $!";
+
+    local $/;
+    my $contents = <$in>;
+
+    close($in);
+
+    return $contents;
+}
+
+my $unsolved_sth =
+    $dbh->prepare("INSERT INTO $runs_table (idx, status, num_checked, num_generated) VALUES (?, 'U', ?, ?)");
+
+my $solved_sth = 
+    $dbh->prepare("INSERT INTO $runs_table (idx, status, num_checked, num_generated) VALUES (?, 'S', ?, ?)");
+
+my $solution_sth = 
+    $dbh->prepare("INSERT INTO $solutions_table (idx, solution) VALUES (?, ?)");
+
+foreach my $deal (1 .. 1_000_000)
+{
+    print STDERR "Reached $deal\n";
+
+    my $fn = "range-check/$deal.rs";
+
+    my $text = _slurp($fn);
+   
+    if ($text =~ m{\AUnsolved!})
+    {
+        if ($text !~ m{^Total number of states checked is (\d+)\.\nThis scan generated \1 states\.$}ms)
+        {
+            die "Mismatching numbers in $fn.";            
+        }
+        else
+        {
+            my $num = $1;
+       
+            $unsolved_sth->execute($deal, $num, $num);
+        }
+    }
+    elsif ($text =~ m{\ASolved!})
+    {
+        if ($text !~ m{^Total number of states checked is (\d+)\.\nThis scan generated (\d+) states\.$}ms)
+        {
+            die "Mismatching lines in $fn.";
+        }
+        else
+        {
+            my ($checked, $gen) = ($1, $2);
+            
+            $solved_sth->execute($deal, $checked, $gen);
+            
+            my @moves = ($text =~ m{^Move a card from stack (\d+) to the foundations\n\nInfo: Card moved is ($card_re)\n\n\n====================\n}gms);
+            
+            if (@moves != 51*2)
+            {
+                die "Incorrect number of moves in file $fn.";
+            }
+            my $i = 0;
+            my ($stacks, $cards) = part { $i++ % 2 } @moves;
+            $solution_sth->execute($deal, join("",
+                    &zip([@stack_to_chr{@$stacks}], [@card_str_to_chr{@$cards}])
+                )
+            );
+        }
+    }
+    else
+    {
+        die "File $fn does not start well!";
+    }
+}

black-hole-solitaire/all-in-a-row-range-solving/stats.pl

+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Statistics::Descriptive;
+
+sub _slurp
+{
+    my $filename = shift;
+
+    open my $in, "<", $filename
+        or die "Cannot open '$filename' for slurping - $!";
+
+    local $/;
+    my $contents = <$in>;
+
+    close($in);
+
+    return $contents;
+}
+
+my $unsolved_stats = Statistics::Descriptive::Full->new();
+my $solved_stats_checked = Statistics::Descriptive::Full->new();
+my $solved_stats_gen = Statistics::Descriptive::Full->new();
+
+foreach my $n (1 .. 1_000_000)
+{
+    if ($n % 1_000 == 0)
+    {
+        print STDERR "Processing $n\n";
+    }
+
+    my $fn = "$n.rs";
+
+    my $text = _slurp($fn);
+
+    if ($text =~ m{\AUnsolved!})
+    {
+        if ($text !~ m{^Total number of states checked is (\d+)\.\nThis scan generated \1 states\.$}ms)
+        {
+            die "Mismatching numbers in $fn.";            
+        }
+        else
+        {
+            $unsolved_stats->add_data($1);
+        }
+    }
+    elsif ($text =~ m{\ASolved!})
+    {
+        if ($text !~ m{^Total number of states checked is (\d+)\.\nThis scan generated (\d+) states\.$}ms)
+        {
+            die "Mismatching lines in $fn.";
+        }
+        else
+        {
+            my ($checked, $gen) = ($1, $2);
+            $solved_stats_checked->add_data($checked);
+            $solved_stats_gen->add_data($gen);
+        }
+    }
+}
+
+foreach my $spec
+(
+    {
+        title => "Unsolved",
+        obj => $unsolved_stats,
+    },
+    {
+        title => "Solved (Checked)",
+        obj => $solved_stats_checked,
+    },
+    {
+        title => "Solved (Generated)",
+        obj => $solved_stats_gen,
+    },
+)
+{
+    my ($title, $stats) = @{$spec}{qw(title obj)};
+    print "$title\n";
+    print "---------------------------\n";
+    print "Count: " , $stats->count(), "\n";
+    print "Min: " , $stats->min(), "\n";
+    print "Max: " , $stats->max(), "\n";
+    print "Average: " , $stats->mean(), "\n";
+    print "StdDev: " , $stats->standard_deviation(), "\n";
+    print "Median: " , $stats->median(), "\n";
+    print "\n";
+}
+