← Back to branch summary

~ubuntu-branches/ubuntu/saucy/freecell-solver/saucy

« back to all changes in this revision

Viewing changes to scripts/Test-connected-components-ID.pl

  • Committer: Package Import Robot
  • Author(s): Gergely Risko
  • Date: 2012-06-22 10:08:05 UTC
  • mfrom: (1.1.6)
  • Revision ID: package-import@ubuntu.com-20120622100805-evoda1ccdr8vt5xr
Tags: 3.12.0-1
http://bugs.debian.org/675262
New upstream version. (closes: #675262)

Show diffs side-by-side

added added

removed removed

Lines of Context:
scripts/Test-connected-components-ID.pl
 
1
#!/usr/bin/perl
 
2
 
 
3
use strict;
 
4
use warnings;
 
5
 
 
6
use Games::Solitaire::Verify::Solution;
 
7
 
 
8
open my $dump_fh, '<', '982.dump'
 
9
    or die "Cannot open 982.dump";
 
10
 
 
11
my $initial_state_str;
 
12
my $initial_board;
 
13
 
 
14
my $two_fc_variant = Games::Solitaire::Verify::VariantsMap->new->get_variant_by_id('freecell');
 
15
 
 
16
$two_fc_variant->num_freecells(2);
 
17
 
 
18
my %components = ();
 
19
my %states_to_components = ();
 
20
 
 
21
while (my $line = <$dump_fh>)
 
22
{
 
23
    if (($line =~ m{^Foundations}) .. ($line !~ /\S/))
 
24
    {
 
25
        my $state_str = '';
 
26
        while ($line !~ /\S/)
 
27
        {
 
28
            $state_str .= $line;
 
29
            $line = <$dump_fh>;
 
30
        }
 
31
        # $state_str is now ready.
 
32
        if (!defined($initial_state_str))
 
33
        {
 
34
            $initial_state_str = $state_str;
 
35
            $initial_board = Games::Solitaire::Verify::State->new(
 
36
                {
 
37
                    string => $initial_state_str,
 
38
                    variant => "custom",
 
39
                    variant_params => $two_fc_variant,
 
40
                }
 
41
            );
 
42
        }
 
43
 
 
44
        my $board = Games::Solitaire::Verify::State->new(
 
45
            {
 
46
                string => $initial_state_str,
 
47
                variant => "custom",
 
48
                variant_params => $two_fc_variant,
 
49
            }
 
50
        );
 
51
 
 
52
        my $found_str = join(',',
 
53
            map { $board->get_foundation_value($_, 0) } (0 .. 3)
 
54
        );
 
55
 
 
56
        my @columns_non_free_lens;
 
57
 
 
58
        foreach my $col_idx (0 .. ($board->num_columns - 1))
 
59
        {
 
60
            my $col = $board->get_column($col_idx);
 
61
 
 
62
            my $get_non_free_len = sub {
 
63
                my $non_free_len = $col->len();
 
64
 
 
65
                while ($non_free_len > 1)
 
66
                {
 
67
                    my $child = $col->pos($non_free_len-1);
 
68
                    my $parent = $col->pos($non_free_len-2);
 
69
 
 
70
                    if (not (($child->color() ne $parent->color())
 
71
                        &&
 
72
                        ($child->rank()+1 == $parent->rank())))
 
73
                    {
 
74
                        return $non_free_len;
 
75
                    }
 
76
                }
 
77
                continue
 
78
                {
 
79
                    $non_free_len--;
 
80
                }
 
81
                return 0;
 
82
            };
 
83
 
 
84
            push @columns_non_free_lens, $get_non_free_len->();
 
85
        }
 
86
 
 
87
        my $component_id = $found_str . ';' . join(',', @columns_non_free_lens);
 
88
 
 
89
        if (exists($states_to_components{$state_str}))
 
90
        {
 
91
            if ($states_to_components{$state_str} ne $component_id)
 
92
            {
 
93
                die "MisMATCH! <<<$state_str>>> ; <<<$component_id>>> ; <<<$states_to_components>>>";
 
94
            }
 
95
        }
 
96
        elsif (exists($components{$component_id}))
 
97
        {
 
98
            die "Two component IDs with different components - <<<$component_id>>>!";
 
99
        }
 
100
        else
 
101
        {
 
102
            $components{$component_id} = 1;
 
103
            # Do a BrFS scan on the fully connected component.
 
104
 
 
105
        }
 
106
    }
 
107
}