q1_test.pl

gistfile1.txt

use v5.30.0;
use warnings;

my @segments =
([0, 1, 3],
[0, 2, 5],
[1, 3, 6],
[1, 4, 8],
[2, 4, 7],
[2, 5, 9],
[3, 4, 5],
[3, 6, 10],
[3, 7, 12],
[4, 7, 11],
[4, 8, 13],
[5, 8, 12],
[5, 9, 14],
[6, 7, 8],
[7, 8, 9],
[10, 11, 12],
[11, 12, 13],
[12, 13, 14]);

# TO-DO check correctness of hand-input

my @r_seg = map {[reverse $_->@*]} @segments;
push @segments, @r_seg;

my @positions = (0..14);
my @holes = (4);
my @balls = (0..3, 5..14);

sub find_possible_nxt_states {
    my @holes = $_[0]->@*;
    my @balls = $_[1]->@*;
    # TO-DO check cardinality of balls and holes are 15
    my @nxt_states;
    
    for my $seg (@segments) {
        if  ((grep {$seg->[0] == $_} @holes)
            && (grep {$seg->[2] == $_} @balls)
            && (grep {$seg->[1] == $_} @balls)
        ) {
            push @nxt_states, step([@holes], [@balls], $seg);
        }
    }

    return [@nxt_states];
    # [
    #    { balls => [], holes => [] },
    #    { balls => [], holes => [] },
    # ]
}

sub step {
    my @holes = $_[0]->@*;
    my @balls = $_[1]->@*;
    my $segment = $_[2];
    push @holes, $segment->[2], $segment->[1];
    @holes = grep {$_ != $segment->[0]} @holes;
    @balls = grep {$_ != $segment->[1] && $_ != $segment->[2]} @balls;
    push @balls, $segment->[0];
    return { balls => [@balls], holes => [@holes] };
}

my $num_of_soln = 0;

sub game_tree_traversal {
    my @holes = $_[0]->@*;
    my @balls = $_[1]->@*;
    my @nxt_states = find_possible_nxt_states([@holes], [@balls])->@*;
    do {say $balls[0]; $num_of_soln++ }
        if scalar @balls == 1;
    if (scalar @nxt_states == 0) {
        return; 
    }
    for my $nxt_state (@nxt_states) {
        game_tree_traversal($nxt_state->{holes}, $nxt_state->{balls});
    }
}

# game_tree_traversal([0..6, 10..14, 7], [8, 9]);

game_tree_traversal([@holes], [@balls]);

say $num_of_soln;