Chess-Plisco

 view release on metacpan or  search on metacpan

lib/Chess/Plisco/Engine/Tree.pm  view on Meta::CPAN

						push @bad_captures, $move;
					}
				} elsif ($move == $k1) {
					$k1[0] = $move;
				} elsif ($move == $k2) {
					$k2[0] = $move;
				} elsif ($move == $k3) {
					$k3[0] = $move;
				} else {
					push @quiet, $move;
				}
			}
			@good_captures = sort { $good_captures{$b} <=> $good_captures{$a} || $b <=> $a } keys %good_captures;
			@bad_captures = sort { $mvv_lva[$b] <=> $mvv_lva[$a] || $b <=> $a } @bad_captures;
		} else {
			# Minimal sorting.
			foreach my $move (@moves) {
				if (((($move) & 0x1fffc0) == (($pv_move) & 0x1fffc0))) {
					push @pv, $move;
				} elsif (((($move) & 0x1fffc0) == (($tt_move) & 0x1fffc0))) {
					push @tt, $move;
				} elsif (my $promote = ((($move) >> 6) & 0x7)) {
					if ((GOOD_PROMO_MASK >> $promote) & 1) {
						push @promotions, $move;
					} else {
						push @quiet, $move;
					}
				} elsif (((($move) >> 3) & 0x7)) {
					push @good_captures, $move;
				} elsif ($move == $k1) {
					$k1[0] = $move;
				} elsif ($move == $k2) {
					$k2[0] = $move;
				} elsif ($move == $k3) {
					$k3[0] = $move;
				} else {
					push @quiet, $move;
				}
			}
			@good_captures = sort { $mvv_lva[$b & 0x3f] <=> $mvv_lva[$a & 0x3f] } @good_captures;
		}

		# Apply history bonus and malus to all quiet moves. We store the bonuses
		# in the upper 32 bits so that we can do a simple integer sort.
		foreach my $move (@quiet) {
			$move |= (($cutoff_moves->[($move & 0x1ffe00) >> 9]) << 32);
		}
		@quiet = sort { $b <=> $a } @quiet;

		@moves = (@pv, @tt, @promotions, @checks, @good_captures, @k1, @k2, @k3, @quiet, @bad_captures);
	}

	my $legal = 0;
	my $moveno = 0;
	my $pv_found;
	my $is_null_window = $beta - $alpha == 1;
	my $best_move = 0;
	my $print_current_move = $ply == 1 && $self->{print_current_move};
	my $signature_slot = $self->{history_length} + $ply;
	my @check_info = $position->inCheck;
	my @backup = @$position;
	foreach my $move (@moves) {
		next if !$position->checkPseudoLegalMove($move, @check_info);
		my @line;
		$position->move($move, 1);
		$signatures->[$signature_slot] = $position->[CP_POS_SIGNATURE];
		my $nodes_before = $self->{nodes}++;
		$self->printCurrentMove($move, $legal) if $print_current_move;
		my $score;
		if (DEBUG) {
			my $cn = $position->moveCoordinateNotation($move);
			$self->indent($ply, "move $cn: start search");
			push @{$self->{line}}, $cn;
		}
		if ($pv_found) {
			if (DEBUG) {
				$self->indent($ply, "null window search");
			}
			$score = -alphabeta($self, $ply + 1, $depth - 1,
				-$alpha - 1, -$alpha, \@line, NON_PV_NODE, 1, $tt_pvs, $min_probe_ply);
			if (($score > $alpha) && ($score < $beta)) {
				if (DEBUG) {
					$self->indent($ply, "value $score outside null window, re-search");
				}
				undef @line;
				$score = -alphabeta($self, $ply + 1, $depth - 1,
					-$beta, -$alpha, \@line, NON_PV_NODE, 0, $tt_pvs, $min_probe_ply);
			}
		} else {
			if (DEBUG) {
				$self->indent($ply, "recurse normal search");
			}
			$score = -alphabeta($self, $ply + 1, $depth - 1, -$beta, -$alpha,
				\@line, $pv_node ? PV_NODE : NON_PV_NODE, 0, $tt_pvs,
				$min_probe_ply);
		}

		++$legal;
		++$moveno;
		if (DEBUG) {
			my $cn = $position->moveCoordinateNotation($move);
			$self->indent($ply, "move $cn: value $score");
		}
		@$position = @backup;
		if (DEBUG) {
			pop @{$self->{line}};
		}
		my $root_move;
		if ($node_type == ROOT_NODE) {
			$root_move = $self->{root_moves}->{$move & 0xffff_ffff};
			# The constants for the time management are taken from Stockfish
			# and they use their own units which seem to be 3.5-4.0 centipawns.
			$root_move->{average_score} =
				$root_move->{average_score} != -INF ? ($score + $root_move->{average_score}) >> 1 : $score;
			$root_move->{mean_squared_score} = $root_move->{mean_squared_score} != -INF * INF
									? ($score * abs($score) + $root_move->{mean_squared_score}) / 2
									: $score * abs($score);
			$root_move->{move_effort} += $self->{nodes} - $nodes_before;
			++$self->{total_best_move_changes} if $score > $best_value && $score > $alpha && $legal > 1;
		}
		if ($score > $best_value) {
			$best_value = $score;

			if ($score > $alpha) {
				$best_move = $move;

				$pv_found = 1;
				@$pline = ($move, @line);
				if ($node_type == ROOT_NODE) {
					$self->{score} = $score;
					$self->printPV($pline);
				}

				if ($score < $beta) {
					$alpha = $score;
					if (DEBUG) {
						$self->indent($ply, "raise alpha to $alpha");
					}
				} else {
					if (DEBUG) {
						my $hex_sig = sprintf '%016x', $signature;
						my $cn = $position->moveCoordinateNotation($move);
						$self->indent($ply, "$cn fail high ($score >= $beta), store $score(BOUND_LOWER) \@depth $depth for $hex_sig");
					}

					# Quiet move failing high?
					if (!((($move) >> 3) & 0x7)
					    && !((($move) & 0x1fffc0) == (($pv_move) & 0x1fffc0))
						&& !((($move) & 0x1fffc0) == (($tt_move) & 0x1fffc0))) {
						if (DEBUG) {
							my $cn = $position->moveCoordinateNotation($move);
							$self->indent($ply, "$cn is quiet and becomes new killer move");
						}

						my $killers = $self->{killers}->[$ply];
						($killers->[0], $killers->[1]) = ($move, $killers->[0]);

						# The history bonus should only be given to real quiet
						# moves, not bad captures. Later, when we also give
						# maluses, we still want to give the malus to all
						# previously searched quiet moves.

						# This is the from and to square as one single integer.
						my $from_to = ($move & 0x1ffe00) >> 9;

lib/Chess/Plisco/Engine/Tree.pm  view on Meta::CPAN

	if ($best_value >= $beta) {
		# FIXME! Reduce branching here!
		if (DEBUG) {
			my $hex_sig = sprintf '%016x', $signature;
			if ($tt_hit) {
				$self->indent($ply, "quiescence standing pat ($best_value >= $beta) without tt store for $hex_sig");
			} else {
				$self->indent($ply, "quiescence standing pat ($best_value >= $beta), store no move value $best_value (BOUND_LOWER) \@depth 0 for $hex_sig");
			}
		}

		if (!$tt_hit) {
			$tt->store(
				@tt_address,
				$signature,
				(do {	(($best_value >= VALUE_TB_WIN_IN_MAX_PLY) ? $best_value + $ply : ($best_value <= VALUE_TB_LOSS_IN_MAX_PLY) ? $best_value - $ply : $best_value);}),
				0,
				BOUND_LOWER,
				DEPTH_UNSEARCHED,
				0,
			);
		} else {
			$best_value = $tt_value;
		}

		return $best_value;
	}

	if ($best_value > $alpha) {
		$alpha = $best_value;
	}

	# FIXME! Jump over all the expensive stuff following if there are no
	# moves.
	my @moves = $position->pseudoLegalAttacks; # or goto SKIP_MOVE_LOOP ...

	my (@tt, @promotions, @checks, %captures);
	foreach my $move (@moves) {
		if (((($move) & 0x1fffc0) == (($tt_move) & 0x1fffc0))) {
			push @tt, $move;
		} elsif ((GOOD_PROMO_MASK >> (((($move) >> 6) & 0x7))) & 1) {
			# Skip underpromotions in quiescence.
			push @promotions, $move;
		} elsif ($position->moveGivesCheck($move)) { # FIXME! Too expensive?
			push @checks, $move;
		} else {
			# info depth 10 seldepth 37 score cp 6 nodes 46676164 nps 39461 hashfull 500 tbhits 0 time 1182841 pv e2e4 e7e5 c2c3 g8f6 g1f3 f8e7 f3e5 f6e4 d1g4 e4g5
			# bestmove e2e4 ponder e7e5

			my $see = $position->SEE($move);
			$captures{$move} = $see if $see >= -80;
		}
	}

	my @captures = sort { $captures{$b} <=> $captures{$a} || $b <=> $a } keys %captures;
	@moves = (@tt, @promotions, @checks, @captures);

	my $signatures = $self->{signatures};
	my $signature_slot = $self->{history_length} + $ply;
	my @check_info = $position->inCheck;
	my @backup = @$position;

	my $legal = 0;
	my $best_move = 0;
	foreach my $move (@moves) {
		next if !$position->checkPseudoLegalMove($move, @check_info);
		$position->move($move, 1);
		$signatures->[$signature_slot] = $position->[CP_POS_SIGNATURE];
		if (DEBUG) {
			my $cn = $position->moveCoordinateNotation($move);
			push @{$self->{line}}, $cn;
			$self->indent($ply, "move $cn: start quiescence search");
		}
		++$self->{nodes};
		++$legal;
		if (DEBUG) {
			$self->indent($ply, "recurse quiescence search");
		}
		my $score = -quiesce($self, $ply + 1, -$beta, -$alpha, $node_type, $min_probe_ply);
		if (DEBUG) {
			my $cn = $position->moveCoordinateNotation($move);
			$self->indent($ply, "move $cn: value: $score");
			pop @{$self->{line}};
		}
		@$position = @backup;
		if ($score > $best_value) {
			$best_value = $score;

			if ($score > $alpha) {
				$best_move = $move;

				if ($score < $beta) {
					if (DEBUG) {
						$self->indent($ply, "raise quiescence alpha to $alpha");
					}
					$alpha = $score;
				} else {
					if (DEBUG) {
						my $hex_sig = sprintf '%016x', $signature;
						my $cn = $position->moveCoordinateNotation($move);
						$self->indent($ply, "$cn quiescence fail high ($score >= $beta), store $score (BOUND_LOWER) \@depth 0 for $hex_sig");
					}

					last;
				}
			}
		}
	}

	my $tt_type = $best_value >= $beta ? BOUND_LOWER : BOUND_UPPER;
	$tt->store(
		@tt_address, # Address.
		$signature, # Zobrist key.
		(do {	(($best_value >= VALUE_TB_WIN_IN_MAX_PLY) ? $best_value + $ply : ($best_value <= VALUE_TB_LOSS_IN_MAX_PLY) ? $best_value - $ply : $best_value);}), # score, mate distance adjusted.
		$tt_hit && $tt_pv, # PV flag.
		$tt_type, # BOUND_EXACT/BOUND_UPPER/BOUND_LOWER.
		DEPTH_QUIESCENCE, # Depth searched.
		$best_move # Best move at this node.
	);
	if (DEBUG) {
		my $hex_sig = sprintf '%016x', $signature;
		my $type = BOUND_TYPES->[$tt_type];
		$self->indent($ply, "returning best value (quiescence) $best_value, store ($type) for $hex_sig");
	}

	return $best_value;
}

sub rootSearch {
	my ($self, $pline) = @_;

	$self->{nodes} = 0;

	my $position = $self->{position};

	my $max_depth = $self->{max_depth} || (MAX_PLY - 1);
	my $depth = $self->{depth} = 0;
	$self->{seldepth} = 0;
	my $score = $self->{score} = 0;

	my @line = @$pline;

	my $last_best_move;
	my $last_best_move_depth = 0;
	my $search_again_counter = 0;

lib/Chess/Plisco/Engine/Tree.pm  view on Meta::CPAN

			#$self->debug("best move: $cn");
		}
	}

	return $tt_move if $tt_move;
}

sub tbRankRootMoves {
	my ($self) = @_;

	my $tb = $self->{tb};

	$self->{tb_root_hit} = 0;

	# Limit probe depth to 0 if table piece count too small.
	if ($self->{tb_probe_limit} > $self->{tb_cardinality}) {
		$self->{tb_probe_limit} = $self->{tb_cardinality};
		$self->{tb_probe_depth} = 0;
	}

	my $pos = $self->{position};
	
	if (!$pos->[CP_POS_CASTLING_RIGHTS]
	    && $pos->[CP_POS_POPCOUNT] <= $self->{tb_probe_limit}) {
		if ($self->{use_time_management}) {
			my $min_time = $self->{tb_7} / (5 ^ (7 - $pos->[CP_POS_POPCOUNT]));
			if ($min_time < $self->{tb_3}) {
				$min_time = $self->{tb_3};
			}
			if ($self->{maximum} < $min_time) {
				return;
			}
		}
		$self->{tb_root_hit} = 1 if $self->tbRootProbe;
	}
}

sub tbRootProbe {
	my ($self) = @_;

	my $pos = $self->{position}->copy;

	my $tb = $self->{tb};

	# Probe for the outcome of the game.
	my $wdl = $tb->safeProbeWdl($pos);
	return if !defined $wdl;

	my $wdl_sign = $wdl <=> 0;

	# First determine whether we are winning or losing.
	my $winning = $wdl > 0;
	if ($wdl == 0) {
		# In case of a draw, we want to escape there, if we are behind.
		my $static_eval = $pos->evaluate;
		$winning = $static_eval > 0;
	}

	# Pass 1. Probe all root moves.
	my $root_moves = $self->{root_moves};
	my @backup = @$pos;

	# Pass 2.
	# Discard all moves that change the outcome of the game.  They cannot be
	# part of the PV.
	#
	# We want to order the moves by the DTZ of the position after the move
	# has been made.
	foreach my $move (keys %{$root_moves}) {
my $san = $pos->SAN($move);
		$pos->move($move);

		$root_moves->{$move}->{tb_wdl} = $tb->safeProbeWdl($pos);
		# We consider a missing WDL table a configuration error.
		return if !defined $root_moves->{$move}->{tb_wdl};

		if (($root_moves->{$move}->{tb_wdl} <=> 0) != -$wdl_sign) {
			delete $root_moves->{$move};
			goto UNDO_MOVE;
		}

		# First, get mate, stalemate out of the way.
		my @legal = $pos->legalMoves;
		if (!@legal) {
			if ($pos->inCheck || !$winning) {
				# We have found a mate or stalemate. Our single-threaded
				# engine cannot be used for multiPV analysys. We can just as
				# well bypass the search altogether and return the winning
				# move.
				$self->{root_moves} = { $move => $self->{root_moves}->{$move} };
				return;
			} else {
				# A stalemate but we are winning.
				delete $root_moves->{$move};
				goto UNDO_MOVE;
			}
		}

		# Does the move result in a draw by insufficient material?
		if ($pos->insufficientMaterial) {
			if ($winning) {
				# Don't even consider that move.
				delete $root_moves->{$move};
				goto UNDO_MOVE;
			} else {
				# Force playing this move.
				$self->{root_moves} = { $move => $self->{root_moves}->{$move} };
				return;
			}
		}

		# If the probe fails, treat all moves equally.
		my $dtz = -$tb->safeProbeDtz($pos) // 0;

		# We will later try to filter out moves that will result in an
		# unwanted draw by the 50-move-rule.
		my $hmc = $pos->[CP_POS_HALFMOVE_CLOCK];

		if ($hmc == 0) {
			# The current move is a pawn push or capture. The DTZ is that
			# of the next endgame phase. Compared to the DTZ before that, it will
			# make a leap and is useless for move ordering. Therefore, we
			# use the DTZ from the position before which was -1, -101, 0, 1, or
			# 101. However, the position before hasn't been probed. But we can
			# deduce the value from the WDL:
			$dtz = (-67 * $wdl * $wdl * $wdl + 269 * $wdl) >> 1;
		} else {
			# We have already handled stalemate and draw because of
			# insufficient material. Now check the draws that have to be
			# claimed.

			# Check for draw by 3-fold repetition. Unlike the normal
			# search, the root search has to check that this is really
			# the 3rd repetition.
			my $signature = $pos->[CP_POS_SIGNATURE];
			my @repetitions = grep { $_ == $signature } @{$self->{signatures}};
			my $is_draw = @repetitions > 1;

			$root_moves->{$move}->{tb_draw} = $is_draw;

			# Correct the DTZ by 1 and apply the offset for the first move.
			if ($dtz > 0) {
				++$dtz;
			} elsif ($dtz < 0) {
				--$dtz;
			}

			if ($is_draw) {
				$root_moves->{$move}->{tb_rank} = 0;
			} else {
				$root_moves->{$move}->{tb_rank} = $dtz;
			}
		}

		$root_moves->{$move}->{tb_abs_dtz} = $hmc - 1 + abs $dtz;

		UNDO_MOVE: @$pos = @backup; # Undo move.
	}

	if ($self->{tb_50_move_rule}) {
		my (@drawing, @rule50, @other);
		foreach my $move (keys %{$root_moves}) {
			my $root_move = $root_moves->{$move};

			if ($root_move->{tb_rank} == 0) {
				push @drawing, $move;
			} elsif ($root_move->{tb_abs_dtz} > 100) {
				push @rule50, $move;
			} else {
				push @other, $move;
			}
		}

		if ($winning) {
			if (@other) {
				delete @{$root_moves}{@drawing};
				delete @{$root_moves}{@rule50};
			} else {
				my $min_dtz = min map { $root_moves->{$_}->{tb_abs_dtz }} keys %$root_moves;
				foreach my $move (keys %$root_moves) {
					delete $root_moves->{$move} if $root_moves->{$move}->{tb_abs_dtz} != $min_dtz;
				}
			}
		} else {
			if (@drawing) {
				delete @{$root_moves}{@other};
			}
		}
		$self->{tb_outcome} = $wdl == WDL_WIN ? 20000 : $wdl == WDL_LOSS ? -20000 : 0;
	} else {
		my (@drawing, @other) = @_;

		foreach my $move (keys %{$root_moves}) {
			my $root_move = $root_moves->{$move};
			if ($root_move->{tb_rank} == 0) {
				push @drawing, $move;
			} else {
				push @other, $move;
			}
		}

		if ($winning) {
			if (@other) {
				delete @{$root_moves}{@drawing};
			}
		} else {
			if (@drawing) {
				delete @{$root_moves}{@other};
			}
		}
		$self->{tb_outcome} = 20000 * $wdl_sign;
	}

	return $self;
}

# Fill the lookup table for the move values.



( run in 1.291 second using v1.01-cache-2.11-cpan-39bf76dae61 )