q1.pl

gistfile1.txt

use v5.30.0;
use warnings;
use List::Util qw/uniqint shuffle/;

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]
);

for my $s (@segments) { #checking
    die "segment input ERROR" unless 
        ($s->[2]-$s->[1] == $s->[1]-$s->[0]+1) 
            || 
        ($s->[2]-$s->[1] == $s->[1]-$s->[0] && $s->[1]-$s->[0] == 1 );
}

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

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

sub find_possible_nxt_states {
    my @holes = $_[0]->@*;
    my @balls = $_[1]->@*;
    die "holes and balls ERROR" unless 15 == uniqint (@holes, @balls);
    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], segment => $segment };
}



sub game_tree_traversal {
    my @holes = $_[0]->@*;
    my @balls = $_[1]->@*;
    my @pasts = $_[2]->@*;
    my @nxt_states = find_possible_nxt_states([@holes], [@balls])->@*;
    say $balls[0] 
        if scalar @balls == 1;
    do {use Data::Printer; p @pasts; exit;}
        if scalar @balls == 1;
    if (scalar @nxt_states == 0) {
        return; 
    }
    for my $nxt_state (shuffle @nxt_states) {
        my @possible_future = @pasts;
        push @possible_future, $nxt_state->{segment};
        game_tree_traversal(
            $nxt_state->{holes}, $nxt_state->{balls}, 
            [@possible_future]
        );
    }
}

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

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