From 0ef22719c41b4d836f83416a65f798c05f756e82 Mon Sep 17 00:00:00 2001 From: Roy Date: Sat, 29 Apr 2023 14:04:58 +0200 Subject: [PATCH] Fix bugs introduced as a result of fixing #1. --- chess_gui/lib/chess_gui.pm | 39 ++++++++++++++++++++------------------ 1 file changed, 21 insertions(+), 18 deletions(-) diff --git a/chess_gui/lib/chess_gui.pm b/chess_gui/lib/chess_gui.pm index fcd43ad..3168cb6 100644 --- a/chess_gui/lib/chess_gui.pm +++ b/chess_gui/lib/chess_gui.pm @@ -170,7 +170,7 @@ sub INIT_KEYS { # For sorted lookup of piece source. sub MOVEMENT_TREE { # Assume relative movement to support abritrary depth (0 < $depth < Inf). my ($player, $depth, $i_al, $i) = (@_[0, 1], $_[5] // $_[0]*16-1, $_[2] // -4); # Support for travelling to different tree depths every player turn (could be used to create, e.g., adaptive AI). - my (@xid, $prio, %key_list_by_value, @selection); + my ($ice, $prio, %key_list_by_value, @selection); $i += 4; ALLY_SOURCE: foreach my $asrc (&KEYS($player)) { my $dpval = $_[3] // 0; # Default piece value. @@ -186,14 +186,14 @@ sub MOVEMENT_TREE { # Assume relative movement to support abritrary depth (0 < $ {no warnings; $tmpalg{$tmpkey} = $ditet[2/($player+1)+1]}; if ($player == $user_mode) {if (defined($prop{$asrc}) and (join '', @{$prop{$asrc}}) eq $_[7] and ($_[8] eq $tree[$i]{$asrc}[$c] or (defined($prop{$tree[$i]{$asrc}[$c]}) and $_[8] eq (join '', @{$prop{$tree[$i]{$asrc}[$c]}})))) {$tmpalg{$tmpkey} = 'Inf'; $sth10->execute($_[9], $ditet[0], $ditet[1])}} #else { my $val = $tmpalg{$tmpkey}; - push @{$key_list_by_value{$val}}, $tmpkey; + push @{$key_list_by_value{$val}}, ($tmpkey, @ditet[0, 1]); unless (defined($prio)) { $prio = $val; - @xid[0, 1] = @ditet[1, 0]; +# @xid[0, 1] = @ditet[0, 1]; } if ($val > $prio) { $prio = $val; - @xid[0, 1] = @ditet[1, 0]; +# @xid[0, 1] = @ditet[0, 1]; } # } $keys[$i_al] = $asrc; @@ -462,24 +462,25 @@ $sth5->execute($bid, $wid, $tmpalg{$selection}, undef); # if ($player == $user_mode and (join '', @asrc) eq $_[7] and ($_[8] eq $adest or $_[8] eq (join '', @adest))) {$tmpalg{$selection} = 'Inf'; $sth9->execute($_[9], $bid, $wid)} if ($player == $user_mode) {if ($#asrc != -1 and (join '', @asrc) eq $_[7] and ($_[8] eq $adest or $_[8] eq (join '', @adest))) {$tmpalg{$selection} = 'Inf'; $sth10->execute($_[9], $bid, $wid)}} #else { my $val = $tmpalg{$selection}; - push @{$key_list_by_value{$val}}, $selection; + push @{$key_list_by_value{$val}}, ($selection, $bid, $wid); unless (defined($prio)) { $prio = $val; - @xid[0, 1] = ($wid, $bid); +# @xid[0, 1] = ($bid, $wid); } if ($val > $prio) { $prio = $val; - @xid[0, 1] = ($wid, $bid); +# @xid[0, 1] = ($bid, $wid); } # } $keys[$i_al] = $asrc; } } } - for (my $ii = 0; $#{$key_list_by_value{$prio}} >= $ii; $ii++) { - $selection[$ii] = $key_list_by_value{$prio}[$ii]; + for (my $ii = 0; $#{$key_list_by_value{$prio}} >= $ii; $ii += 3) { + push @selection, $key_list_by_value{$prio}[$ii]; } - return ($prio, @xid[0, 1], @selection); + $ice = int(rand($#selection+1)); + return ($prio, $key_list_by_value{$prio}[$ice*3+1], $key_list_by_value{$prio}[$ice*3+2], $selection[$ice], $ice, $#selection); } sub QUEEN { @@ -725,16 +726,18 @@ $user_mode = 0; TURN: foreach my $player (@player) { # @{$diff{'msg'}{'turn'}}[$player] = 'Player ' . $player . ' turn ' . $player_turn . ':'; push @{$diff{$pplayer[$player]}{'status'}}, $player_turn; - my ($depth, $prio, $ice, @selection, @id); + my ($depth, $prio, $ice, $selection, @id, $n_o_selections); my ($dpval, $i_al) = (0, 0); if ($player == $user_mode) { # If the player is human-controlled, we needn't more than $depth 1 (for input validation). $depth = 1; - ($prio, @id[0, 1], @selection) = &MOVEMENT_TREE($player, $depth, undef, undef, undef, undef, undef, $_[0], $_[1], $sessid); + ($prio, @id[0, 1], $selection, $ice, $n_o_selections) = &MOVEMENT_TREE($player, $depth, undef, undef, undef, undef, undef, $_[0], $_[1], $sessid); +print 'w ', $id[0], ' ', $id[1], "\n"; } else { $depth = 2; # Usually about 20^$depth possibilities (but ten times as much iterates for including no movement). - ($prio, @id[0, 1], @selection) = &MOVEMENT_TREE($player, $depth, undef, undef, undef, undef, undef, undef, undef, $sessid); + ($prio, @id[0, 1], $selection, $ice, $n_o_selections) = &MOVEMENT_TREE($player, $depth, undef, undef, undef, undef, undef, undef, undef, $sessid); $sth10->execute($sessid, @id[0, 1]); +print 'b ', $id[0], ' ', $id[1], "\n"; } # print 'keys: ', scalar keys %key_list_by_value, "\n"; # print 'ids: ', $#id, "\n"; @@ -763,7 +766,7 @@ $user_mode = 0; # for (my $ii = 0; $#{$key_list_by_value{$prio}} >= $ii; $ii++) { # $selection[$ii] = $key_list_by_value{$prio}[$ii]; # } - $ice = int(rand($#selection+1)); +# $ice = int(rand($#selection+1)); # } elsif ($user_mode != $player) { # The other side has checkmated you (the AI). The AI should know when to give up (even if it weren't for efficiency reasons). ## @{$diff{'msg'}{'gstatus'}}[$player] = 'Player ' . $player . ' resigns!'; # push @{$diff{$pplayer[$player]}{'status'}}, 5; @@ -834,16 +837,16 @@ $user_mode = 0; } undef @pseudoinfinite_loop_check; } - push @pseudoinfinite_loop_check, $selection[$ice]; + push @pseudoinfinite_loop_check, $selection; push @{$diff{$pplayer[$player]}{'prio'}}, $prio; - push @{$diff{$pplayer[$player]}{'moveno'}}, ($ice+1) . '/' . ($#selection+1); + push @{$diff{$pplayer[$player]}{'moveno'}}, ($ice+1) . '/' . $n_o_selections; # @{$diff{'msg'}{'verbose'}}[$player] = $selection[$ice]; - $what_i_did[$player]{$selection[$ice]} = $prio; + $what_i_did[$player]{$selection} = $prio; my $c = 0; my $adest; - foreach (split /,/, $selection[$ice]) { + foreach (split /,/, $selection) { if (defined($keys[$c]) and $keys[$c] != $_) { $adest = $_; last;