/* * CHEST, chess analyst. For Copyright notice read file "COPYRIGHT". * * $Source: /home/heiner/ca/chest/RCS/answer.c,v $ * $Id: answer.c,v 3.13 1999/07/20 20:59:03 heiner Exp $ * * implement answer heuristics * * Ideas: when total material of attacker is low, beating it is better */ #include "bsd.h" #include "types.h" #include "board.h" #include "mgsubr.h" #include "mlsubr.h" #include "move.h" #include "move_gen.h" #include "trace.h" #include "analyse.h" #include "answer.h" /* * Deleted when changing RCS revision 1.5 -> 2.1: * sort_simple() * copy_movelist() * sort_movelist() * sort_weighted_simple() */ /* * GENERAL: * This module tries to select from all legal defender moves * those, which should be used first, as we expect them to * lead to a cheaper overall analysis. * * While the first objective of the defender is to avoid a mate, * this is in almost all occurring positions no problem. * As most of the legal attacker moves are analysed, anyhow, * in most cases the defender cannot be mated regardless * of his move. * * But, the different defender moves tend to lead to sub-analysis * of different cost. The effort needed to show the attacker * to be incapable of mating tends to be larger, when he has more * legal moves. * * Hence, the real objective of the defender is: * (A) to cut down the move possibilities of the attacker, and * (B) to make a mate combination more absurd. * * Methods to achieve such (in approximate order of importance) are: * (a) Beat attacker pieces: those cannot have have any legal * move in any further depth. In extreme cases this may * lead to a naked attacker king, which then cannot mate * anymore. * (b) Say 'check' to the attacker. He cannot ignore it, * and is severly restricted in his move possibilies * in the directly following level. * (c) Restrict the move possibilities of the attacker king. * King moves are a not so small percentage of all attacker moves. * Bayer 9-mate: 3.57 per mg, 34.4% of all moves. * att in check: 75.4% of mg-calls * (d) Pinning attacker pieces. Restricts its moving capabilities * for one or more further levels. Prepares beat. * (e) Move the defender K to a less dangerous field. * Where it is restricted by less border, and by less actual * attacker threats. * (f) Prepare some of the above by unpinning a defender piece. * (g) Prepare some of the above by promotion. * (h) Prepare promotion by advancing (promising) pawns. * (i) Block attacker promotions. * * Statistics from Bayer 9-mate: * - when defender is in check: 2.09 K-moves / mg-call * - attacker is in check: 75.4% of mg-calls * - attacker K-moves: 3.57 / mg-call * 34.4% of all attacker moves * - average # of moves per piece: FFS * * MRFC = missing reason for constant */ static int8 mat_val[MAX_FIGURES] ={ /* [ Figure ] */ /* B S L T D K */ 1, 3, 3, 5, 9, 0 /* material in B units */ }; /* FFS: typical # of moves per piece */ /* ============================================================================ * Level 2 heuristic. * */ #define LEV2_PROM_BLOCK 0 /* CF: too expensive */ Eximpl int /*ARGSUSED*/ sort_2_weighted( int depth, /* is 2, ignored here */ register Xconst Board* bp, /* defender to move */ register Movelist* lp) /* all legal defender moves */ { register Move* mp; register Xconst Field* tp; register Xconst Field* fp; register rPieceSet emask; /* enemies (attackers) */ register Xconst Field* dkp; /* defender's king (ours) */ register int v; register rColour enemy; PieceSet dkatt; int kescs; /* # def-K escapes */ #if LEV2_PROM_BLOCK int epromlin; /* enemies promotion line */ #endif if( list_length(lp) <= 1 ) { return 0; /* nothing to be sorted */ } if( ! (lp->l_attr & LA_CK) ) { ml_ck_attr(bp, lp); /* get checking attributes */ } enemy = opp_colour(bp->b_tomove); dkp = K_FP(bp, bp->b_tomove); emask = COLOUR_MASK(enemy); /* all enemies */ dkatt = BOTH_KINGS & ~emask; /* our king */ kescs = -1; /* not yet computed */ #if LEV2_PROM_BLOCK epromlin = PROM_LIN(enemy); #endif formoves(lp, mp) { fp = &(bp->b_f[mp->m_from]); tp = &(bp->b_f[mp->m_to ]); v = 0; /* collect value in "v" */ if( mp->m_attr & MA__CK ) { /* says 'check' */ PieceSet eatts; eatts = F_DATT(tp) & emask; if( eatts & ~BOTH_KINGS ) { v -= 1/*MRFC*/; /* non K may beat back */ } switch( mp->m_attr & MA__CK ) { /*MRFC...*/ case MA_DCK : v += 6; break; /* direct */ case MA_ICK : v += 6; break; /* indirect */ case MA_DCK|MA_ICK : v += 9; break; /* double */ case MA_DCK |MA_NCK: v += 7; break; /* direct near */ case MA_ICK|MA_NCK: v += 7; break; /* indirect near */ case MA_DCK|MA_ICK|MA_NCK: v += 10; break; /* double near */ } } if( tp->f_c != empty ) { /* beats attacker piece */ v += mat_val[tp->f_f]; /* beaten material */ if( F_IATT(dkp) & SET1(tp->f_idx) ) { v += 2/*MRFC*/; /* destroys pinning */ } } #if LEV2_PROM_BLOCK else { if( LIN64(tp->f_pos64) == epromlin ) { register const Field* xp; xp = tp - bau_mov[enemy]; if( (xp->f_f == bauer) && (xp->f_c == enemy) ) { v += 5; /* mat_val[turm] */ } } } #endif if( F_DATT(dkp) & emask ) { /* defender is in check */ /* * analyse king escape situation */ if( mp->m_fig == koenig ) { /* K move while in check */ register Xconst Field* xp; register rPieceSet mask; register int i; mask = emask; if( tp->f_c != empty ) { mask &= ~SET1(tp->f_idx); /* without the beaten one */ } if( kescs < 0 ) { /* not yet computed */ kescs = 0; for( i=MIN_D_DIR ; if_c == enemy) || (xp->f_c == empty)) ) { kescs += 1; } } } v -= kescs; /* those before the move */ for( i=MIN_D_DIR ; if_c == enemy) || (xp->f_c == empty)) && !(F_DATT(xp) & mask) ) { v += 1; } } /* FFS: integrate the following into the above? */ i = pos64_borders[fp->f_pos64] - pos64_borders[tp->f_pos64]; if( i ) { if( i > 0 ) { /* more border around K before move */ v++; }else { v--; } } }else { /* non-K move while in check */ if( F_DATT(fp) & dkatt ) { v += 1; /* MRFC adds potential new K escape */ } if( F_DATT(tp) & dkatt ) { v -= 1; /* MRFC destroys potential K escape */ } } } mp->m_value = v; mp->m_value2 = 0; } /* * The following sort takes ca 28% of the total time of this function. * Mostly the first (best) of the moves is used, only. * FFS: do not sort before needed. */ ml_sort_rdx(lp); return 2; } /* ============================================================================ * For depth >= 3 */ /* * ana_att_moves() * This is a special version of the normal move generator. * While the defender is really to move, we pretend the attacker * being to move, and count what he could do, in order to use it * as a basis to differentiate between the defender moves, * according to how they change what the attacker will be able to do. * * We do not generate the moves themselves, but rather count them, * separately for each piece. The counter vector "mlp" * is indexed by the piece index and incremented. * Hence, the counter array should be cleared, before. * Restrictions: * - the attacker must not be in check (else defender could beat K) * - castling moves are not yet considered * * Returns the number of all counted moves. */ static int /* total number of moves found */ ana_att_moves( register Xconst Board* bp, /* count opponents moves in */ register int* mlp) /* here [idx] */ { register Xconst Field* tp; register int tpos; register int delta; register int i; register int imax; register Xconst Field* p; register int* mp; /* points to element in mlp[] */ Position pos; Colour self; Colour enemy; Position kpos; int8 ifig; int8 minifig; int pindir; PieceSet iatts; PieceSet atts; PieceSet enemymask; int nmoves; nmoves = 0; self = opp_colour(bp->b_tomove); /* attacker, would not be to move */ enemy = opp_colour(self); /* defender, normally to move now */ kpos = K_POS(bp, self); /* Analyse the checking situation of our king: */ enemymask = COLOUR_MASK(enemy); iatts = F_IATT(&(bp->b_f[kpos])) & enemymask; /* those may pin someone */ atts = F_DATT(&(bp->b_f[kpos])) & enemymask; if( atts ) { /* enemy would be able to beat K */ panic("ana_att_moves: check.\n"); } /* decide type of move enumeration */ /* * We are not in check. Thus our pieces can move relatively freely, * as they are not forced to defend against a check. * Thus enumerate the move possibilities by the capable figures: */ minifig = COLOUR_IDX(self); for( ifig = minifig + bp->b_max_piece[self] - 1 ; ifig >= minifig ; --ifig ) { /* enumerate non-K pieces */ pos = bp->b_piece[ifig]; if( no_pos(pos) ) continue; /* skip empty slot (beaten piece) */ p = &(bp->b_f[pos]); mp = &mlp[ifig]; /* increment here for every move */ /* Analyse the pinning of this piece: */ pindir = NO_DIR; if( (atts = (iatts & F_DATT(p))) ) { i = att_dir(pos, kpos); if( dam_dir(i) ) { delta = dam_mov[i]; if( (pos + delta) != kpos ) { if( atts & F_IATT(&(p[delta])) ) { pindir = i; } }else { /* Piece to be checked is near to its king. * Therefore there is only one f_iatt, * which alone is not sufficient for * check of direction. * If T-dir, we are already sure to be pinned. */ if( trm_dir(i) ) { pindir = i; }else { /* L-dir, search: */ tp = p; do { tp -= delta; }while( tp->f_c == empty ); if( (tp->f_c == enemy) && (atts & SET1(tp->f_idx)) ) { pindir = i; } } } } } switch( p->f_f ) { case bauer: /* Try single and double step: */ delta = bau_mov[self]; if( no_dir(pindir) || (delta == dam_mov[pindir]) || (delta == dam_mov[opp_dir(pindir)]) ) { /* Not pinned or staying in pinning */ tpos = pos; for( i=0 ; i<2 ; ++i ) { if( i && (LIN64(p->f_pos64) != BAS_LIN(self)) ) break; tpos += delta; if( bp->b_f[tpos].f_c != empty ) break; if( LIN64(p->f_pos64) == BAS_LIN(enemy) ) { *mp += 4; nmoves += 4; }else { *mp += 1; nmoves += 1; } } } /* Try to beat in both directions: */ for( i=0 ; i<2 ; ++i ) { delta = (i ? bau_right : bau_left)[self]; if( ! no_dir(pindir) && (delta != dam_mov[pindir]) && (delta != dam_mov[opp_dir(pindir)]) ) { continue; } /* Not pinned or staying in pinning */ tpos = pos + delta; tp = &(bp->b_f[tpos]); if( (tp->f_c == border) || (tp->f_c == self) ) continue; if( tp->f_c == empty ) { /* try e.p.: */ if( bp->b_ep == (tpos - bau_mov[self]) ) { if( ! ep_legal(bp, pos, tpos, kpos) ) continue; *mp += 1; nmoves += 1; } }else { /* try normal beat: */ if( LIN64(p->f_pos64) == BAS_LIN(enemy) ) { *mp += 4; nmoves += 4; }else { *mp += 1; nmoves += 1; } } } break; case springer: if( ! no_dir(pindir) ) break; /* pinning always left by S */ for( i=0 ; i<8 ; ++i ) { tp = &bp->b_f[pos + spr_mov[i]]; if( (tp->f_c != border) && (tp->f_c != self) ) { *mp += 1; nmoves += 1; } } break; case laeufer: if( no_dir(pindir) ) { i = MIN_L_DIR; imax = MAX_L_DIR; }else if( lfr_dir(pindir) ) { i = pindir & ~1; imax = i + 2; }else { break; } goto ltd; case turm: if( no_dir(pindir) ) { i = MIN_T_DIR; imax = MAX_T_DIR; }else if( trm_dir(pindir) ) { i = pindir & ~1; imax = i + 2; }else { break; } goto ltd; case dame: if( no_dir(pindir) ) { i = MIN_D_DIR; imax = MAX_D_DIR; }else { i = pindir & ~1; imax = i + 2; } ltd: /* When pinned, we here already have restricted * the directions to pindir and its complement. */ for( ; ib_f[pos]); delta = dam_mov[i]; do { tp += delta; if( (tp->f_c == border) || (tp->f_c == self) ) break; *mp += 1; nmoves += 1; }while( tp->f_c == empty ); } break; case koenig: /* is handled below */ break; default: panic("ana_att_moves: figure %d", p->f_f); break; } } /* enumerate non-K pieces */ /* Now add the king moves: */ p = &(bp->b_f[kpos]); mp = &mlp[p->f_idx]; for( i=MIN_D_DIR ; if_c == border) || (tp->f_c == self) ) continue; if( F_DATT(tp) & enemymask ) continue; /* Note, that we are not in check */ *mp += 1; nmoves += 1; } #if 0 /* not yet */ /* Try to castle: */ if( bp->b_castle[self] ) { gen_castle(bp, kpos, lp); } #endif return nmoves; } static Bool fig__can_dir( const Board* bp, /* whether in this Board */ register rPieceSet att, /* one of these SLTD pieces */ int dir) /* might go in this direction */ { register int zeroes; register int i; i = 0; while( att ) { while( ! (att & 01) ) { zeroes = MIN_LOW_ZERO(att); i += zeroes; att >>= zeroes; } switch( bp->b_f[bp->b_piece[i]].f_f ) { case springer: if( spr_dir(dir) ) return 1; break; case laeufer: if( lfr_dir(dir) ) return 1; break; case turm: if( trm_dir(dir) ) return 1; break; case dame: if( dam_dir(dir) ) return 1; break; } att >>= 1; ++i; } return 0; /* not found */ } /* * fig__type() * In the given Board, return the figure type of the lowest bit * found in the given piece set. */ static Figure fig__type( const Board* bp, register rPieceSet att) { register int zeroes; register int i; if( !att ) { return no_figure; } i = 0; while( ! (att & 01) ) { zeroes = MIN_LOW_ZERO(att); i += zeroes; att >>= zeroes; } return bp->b_f[bp->b_piece[i]].f_f; } static const Field* fig__pos( const Board* bp, register rPieceSet att) { register int zeroes; register int i; if( !att ) { return 0; } i = 0; while( ! (att & 01) ) { zeroes = MIN_LOW_ZERO(att); i += zeroes; att >>= zeroes; } return &(bp->b_f[bp->b_piece[i]]); } static Bool fig_can_move( Figure fig, register const Field* fp, register const Field* tp) { register const Field* p; register int delta; int dir; dir = att_dir(fp, tp); if( no_dir(dir) ) { return FALSE; } switch( fig ) { case laeufer: if( !lfr_dir(dir) ) return FALSE; break; case turm: if( !trm_dir(dir) ) return FALSE; break; case dame: if( !dam_dir(dir) ) return FALSE; break; /* heim FFS: default ? */ } /* test path from fp to tp */ delta = dam_mov[dir]; for( p = fp + delta ; p != tp ; p += delta ) { if( p->f_c != empty ) { return FALSE; } } /* heim FFS: tp->f_c ? (empty, enemy) */ return TRUE; } #define LOW_BIT(x) ((x) ^ ((x) & ((x)-1))) #define CLR_LOW_BIT(x) ((x) &= ((x)-1)) #define OWN_VALUE(fig,depth) (mat_val[(fig)] / ((depth)>=5 ? 2 : 3)) /*MRFC*/ #define ATT_VALUE(fig,depth) (mat_val[(fig)] / ((depth)>=5 ? 2 : 3)) /*MRFC*/ #define V2_VAL(n) ((n) - ((n) >> 3)) /* * 0.875 */ /*MRFC*/ #define BIT_SUM32(v) ( bitsum[((unsigned char *) &(v))[0]] \ + bitsum[((unsigned char *) &(v))[1]] \ + bitsum[((unsigned char *) &(v))[2]] \ + bitsum[((unsigned char *) &(v))[3]] \ ) #define OWN_V_RES 0 /* whether own value on result of promotion */ #if (PROD_LEV == 0) && 0 /* CF: local debugging */ # define VV(x) x #else # define VV(x) /*empty*/ #endif static void find_chk_nxt( int depth, Xconst Board* bp, /* defender's board */ Movelist* lp, /* and his legal moves */ const int* fig_moves, /* [f_idx] how many can it (def&att) */ PieceSet ck_figs, /* lp->l_hasckmv FFS */ EscSet escs, /* curr K-escapes of attacker */ EscSet noescs1d, PieceSet does1d) { register const Field* ekp; register rPieceSet emask; register Move* mp; register Xconst Field* p; register Xconst Field* tp; Xconst Field* fp; const Field* dkp; int ma; int beat_fig; int back_ck; int mov_dir; int nxt_dir; int v; int v2; int bestv; int bestv2; int havebest; int tries; Xconst Field* sav_p; PieceSet nxt_ck_fig_set; emask = COLOUR_MASK(opp_colour(bp->b_tomove)); dkp = K_FP(bp, bp->b_tomove ); ekp = K_FP(bp, opp_colour(bp->b_tomove)); nxt_ck_fig_set = 0; /* * Look for a move that may say check one move later */ formoves(lp, mp) { if( mp->m_attr & MA__CK ) continue; /* says check itself */ tp = &(bp->b_f[mp->m_to]); if( (F_DATT(tp) & emask) && (ck_figs & SET1(mp->m_idx)) ) { continue; } if( (mp->m_fig == laeufer) && (pos64_dark[tp->f_pos64] != pos64_dark[ekp->f_pos64]) ) { continue; } bestv = 127; /* really large */ bestv2 = 127; /* really large */ havebest = FALSE; tries = 1; if( dam_dir(att_dir(tp, dkp)) && (F_DATT(tp) & emask & ~BOTH_KINGS) && fig_can_move(fig__type(bp, F_DATT(tp) & emask & ~BOTH_KINGS), tp, dkp) ) { back_ck = 1; }else { back_ck = 0; } fp = &(bp->b_f[mp->m_from]); if( mp->m_fig == springer ) { /* also S-promotion */ /* FFS: darkness test */ for( nxt_dir = 0 ; nxt_dir < 8 ; ++nxt_dir ) { p = tp + spr_mov[nxt_dir]; if( (p->f_c != border) && (p->f_c != bp->b_tomove) && (spr_dir(att_dir(p, ekp))) ) { goto found_ck; } } continue; } /* * check from tp --> ekp * There has to be exactly one piece on that blocks the path. * (expect beat or uncovering) */ nxt_dir = att_dir(tp, ekp); if( dam_dir(nxt_dir) ) { switch( mp->m_fig ) { case laeufer: if( !lfr_dir(nxt_dir) ) { break; } goto indir_by_ltd; case turm: if( !trm_dir(nxt_dir) ) { break; } goto indir_by_ltd; case dame: indir_by_ltd: { int fig_cnt; LegalDelta delta; fig_cnt = 0; delta = dam_mov[nxt_dir]; sav_p = 0; for( p = tp + delta ; p != ekp ; p += delta ) { if( p->f_c != empty ) { if( p->f_c == bp->b_tomove ) { if( !fig_moves[p->f_idx] ) { break; } if( p->f_f == bauer && (COL64(tp->f_pos64)==COL64(ekp->f_pos64)) ) { break; } } if( fig_cnt > 0 ) break; fig_cnt++; sav_p = p; } } if( p == ekp ) { p = sav_p; goto found_ck; } } break; default: break; } continue; /* consider next move */ /*FFS: D */ } switch( mp->m_fig ) { default: /* FFS: B without prom? */ continue; case laeufer: nxt_dir = MIN_L_DIR; ma = MAX_L_DIR; break; case turm: nxt_dir = MIN_T_DIR; ma = MAX_T_DIR; break; case dame: nxt_dir = MIN_D_DIR; ma = MAX_D_DIR; break; } /* * For the rest of the analysis of this move, * the resulting piece is one of LTD (multi-step figure). */ tries = 4; /* try this one harder */ mov_dir = att_dir(fp, tp); VV(printf("Cd %d..%d\n", nxt_dir, ma-1);) for( ; nxt_dir < ma ; ++nxt_dir ) { int delta; if( (nxt_dir == opp_dir(mov_dir)) /* don't move back */ || (tp->f_c == empty && nxt_dir == mov_dir) ) { continue; } beat_fig = 0; delta = dam_mov[nxt_dir]; /* * find a move from tp to a field p, where the * defender may say check. */ for( p = tp ; beat_fig == 0 ; ) { p += delta; if( (p->f_c == bp->b_tomove) || (p->f_c == border) ) { break; /* next dir */ }else if( p->f_c != empty ) { /* enemy */ beat_fig++; } if( !fig_can_move(mp->m_fig, p, ekp) ) /* try to say check! */ continue; /* * If there is a direct way from fp to p, * don't move indirect! */ if( (fp->f_f == mp->m_fig) && fig_can_move(mp->m_fig, fp, p) ) { continue; /* D only */ } found_ck: ; /* entered by S and B-proms, also */ { int bad; int king_moves; int ck_block; PieceSet s; nxt_ck_fig_set |= SET1(mp->m_idx); bad = 0; s = escs; if( SET1(mp->m_idx) & does1d ) { /* * Consider escapes, what is covered before by * only this piece. */ s |= fig_cov[fp->f_f][fp - ekp] & noescs1d; } VV(printf("Cc cov[%d][%2o->%2o] = %3x\n", mp->m_fig, p->f_pos64, ekp->f_pos64, fig_cov[mp->m_fig][p-ekp]);) s &= ~fig_cov[mp->m_fig][p-ekp]; /* -= covered from p */ king_moves = bitsum[s]; switch( mp->m_fig ) { case dame: case turm: case laeufer: ck_block = 1; break; default: /* should not happen */ case koenig: case bauer: case springer: ck_block = 0; break; } if( king_moves < 1 ) { king_moves = 1; /* FFS */ } if( ck_block ) { register Xconst Field* xp; int xdelta; PieceSet eatts; eatts = emask & ~BOTH_KINGS; xdelta = dam_mov[att_dir(tp, p)]; for( xp = tp + xdelta ; xp != p ; xp += xdelta ) { if( F_DATT(xp) & eatts ) bad++; } xdelta = dam_mov[att_dir(p, ekp)]; for( xp = p + xdelta ; xp != ekp ; xp += xdelta ) { if( F_DATT(xp) & eatts ) bad++; } } if( F_DATT(p) & emask ) { #if OWN_V_RES bad += 1 + OWN_VALUE(mp->m_fig,depth-1); /*FFS*/ #else bad += 1; if( mp->m_fig == fp->f_f ) { /* no promotion */ bad += OWN_VALUE(mp->m_fig,depth-1); } /*FFS: promotion: always B value? always D value? */ #endif } if( F_DATT(tp) & emask ) { bad++; /*FFS*/ } bad += back_ck * 2; /*MRFC*/ VV(printf("C> %2o-%2o %d->%d: v=%3d, v2=%3d\n", fp->f_pos64, tp->f_pos64, fp->f_f, mp->m_fig, mp->m_value, mp->m_value2);) VV(printf("C back_ck=%d, bad=%d, k_moves=%d, fig_moves=%d, escs=%3x, s=%3x\n", back_ck, bad, king_moves, fig_moves[p->f_idx], escs, s);) v = mp->m_value; v2 = mp->m_value2; v += back_ck; /*MRFC*/ v2 = (((v - (bad)) * king_moves) + (bad * v) ) / v; if( (depth >= 4) && (p->f_c != empty) ) { VV(printf("C1\n");) v2 -= fig_moves[p->f_idx] >> 2; /*MRFC*/ } if( tp->f_c != empty ) { if( (depth >= 4) && (F_DATT(tp) & nxt_ck_fig_set & ~SET1(mp->m_idx)) ) { VV(printf("C2\n");) /* ??? FFS, Hinterstellung; Bayer-Magie */ v2 -= 3; v /= 2; if( mp->m_fig == springer ) { v--; } if( v < 1 ) v = 1; } } if( v2 < 1 ) v2 = 1; v++; if( depth <= 3 ) { VV(printf("C3\n");) v += 1; v2 += 3; }else if( depth == 4 ) { VV(printf("C4\n");) v += 1; v2 += 1; } VV(printf("C: %2o-%2o %d->%d: v=%3d, v2=%3d\n", fp->f_pos64, tp->f_pos64, fp->f_f, mp->m_fig, v, v2);) if( ! havebest || ((v*v2) < (bestv*bestv2)) ) { bestv = v; bestv2 = v2; havebest = TRUE; } if( --tries <= 0 ) { goto rdy_move; } } } /* scan p in nxt_dir */ } rdy_move:; if( havebest ) { mp->m_value = bestv; mp->m_value2 = bestv2; VV(printf("C< %2o-%2o %d->%d: v=%3d, v2=%3d\n", fp->f_pos64, tp->f_pos64, fp->f_f, mp->m_fig, mp->m_value, mp->m_value2);) } } /* formoves */ } static void /*ARGSUSED*/ try_promotion( int depth, const Board* bp, /* defender's board */ Movelist* lp, /* and his legal moves */ const int* fig_moves, /* [f_idx] how many can it (def&att) */ PieceSet ck_figs, /* lp->l_hasckmv FFS */ EscSet escs, /* curr K-escapes of attacker */ EscSet noescs1d, PieceSet does1d) { /* * Try to push promising promotions. */ register Move* mp; register Move* nearest; int promotion_line; int mindist; int nearcnt; promotion_line = PROM_LIN(bp->b_tomove); nearest = 0; mindist = 999; /* far far away */ nearcnt = 0; formoves(lp, mp) { register int dist; if( mp->m_fig != bauer ) { continue; } dist = promotion_line - LIN(mp->m_to); if( dist < 0 ) dist = -dist; if( dist < mindist ) { mindist = dist; nearest = mp; nearcnt = 1; }else if( dist == mindist ) { nearcnt += 1; } } if( nearest ) { /* * That one would need (1+mindist) moves to promote, * leaving a subjob of depth-(1+mindist). * When that one is at least a 2-mate, * we expect the promotion to help the defender. * FFS: do experiment */ register int subdep; subdep = depth - (1+mindist); /* subjob left after promotion */ if( subdep >= 2 ) { register int decr; switch( subdep ) { case 2: decr = 1; break; case 3: decr = 3; break; default: /* larger values */ case 4: decr = 5; break; } if( nearcnt == 1 ) { nearest->m_value2 -= decr; if( nearest->m_value2 <= 0 ) nearest->m_value2 = 1; }else { /* need rescan */ formoves(lp, mp) { register int dist; if( mp->m_fig != bauer ) { continue; } dist = promotion_line - LIN(mp->m_to); if( dist < 0 ) dist = -dist; if( dist == mindist ) { mp->m_value2 -= decr; if( mp->m_value2 <= 0 ) mp->m_value2 = 1; } } } } } } Eximpl int sort_weighted( int depth, /* depth of current analysis */ register Xconst Board* bp, /* in this board the defender */ Movelist* lp) /* to move has these legal moves */ { #define CHK_B_BLOCK 0 register Move* mp; register Xconst Field* tp; register Xconst Field* fp; register rPieceSet emask; register Xconst Field* dkp; /* pointer to self king (defender) */ register int v; PieceSet dkatt; PieceSet self_mask; Xconst Field* ekp; /* pointer to enemy king (attacker) */ register rColour enemy; int v2; /* width of next att depth */ int have_good_ck; int att_moves; int fig_moves[32]; PieceSet ck_fig_set; int ck_figs; EscSet escs; EscSet cur_king_escs; EscSet noescs1d; PieceSet does1d; #if CHK_B_BLOCK int ebaumov; int epromlin; #endif if( list_length(lp) <= 1 ) { /* <= one move: no choice */ return 0; /* no choice: no sort, no cost */ } if( ! (lp->l_attr & LA_CK) ) { ml_ck_attr(bp, lp); /* we want the checking attributes */ } /* * Fill the counter array 'fig_moves' (indexed by piece index) * with the move possibilities of the attacker, if he were to move now * (although he is not to move, now). */ bzero(fig_moves, 32 * sizeof(int)); att_moves = ana_att_moves( bp, fig_moves ); enemy = opp_colour(bp->b_tomove); dkp = K_FP(bp, bp->b_tomove); ekp = K_FP(bp, enemy ); emask = COLOUR_MASK(enemy); self_mask = COLOUR_MASK(bp->b_tomove); dkatt = BOTH_KINGS & self_mask; /* our king */ #if CHK_B_BLOCK ebaumov = bau_mov [enemy]; epromlin = PROM_LIN(enemy); #endif have_good_ck = 0; ck_fig_set = lp->l_hasckmv; ck_figs = BIT_SUM32(ck_fig_set); /* * king escapes for attackers king */ escs = 0; noescs1d = 0; does1d = 0; for( v=MIN_E_DIR ; vf_c == border) || ((tp->f_c == ekp->f_c) && !zero_dir(v)) ) { continue; /* blocked */ } if( F_DATT(tp) & self_mask ) { /* forbidden by direct att */ if( max1elems(F_DATT(tp) & self_mask) ) { noescs1d |= (1 << v); /* no escape, 1 dir-att */ does1d |= F_DATT(tp); } continue; } escs |= (1 << v); /* is an escape for enemy K */ } does1d &= self_mask; /* those attacks are singly to enemy K */ /* * Now we are prepared to scan the move list of the defender. * Into the two components "m_value" and "m_value2" we fill * what we think will be the attackers move list lengths in the * next two moves. * These are later multiplied, which is a good guess of the * width of the analysis. As we, the defender, like the tree * to be small, this product is then negated and sorted descending. */ formoves(lp, mp) { fp = &(bp->b_f[mp->m_from]); /* from, move source */ tp = &(bp->b_f[mp->m_to]); /* to , move destination */ fig_moves[mp->m_idx]++; /* count defender, too */ /* * First, use 'att_moves' as a basis, and compute 'v', * the number of attacker moves after this defender move at 'mp'. * If 'mp' beats a piece, it will not move any more. * The enemy's king escapes may change by doing 'mp'. */ v = att_moves; if( tp->f_c != empty ) { v -= fig_moves[tp->f_idx]; /* beaten piece cannot move */ } #if CHK_B_BLOCK else { register const Field* xp; xp = tp - ebaumov; if( (xp->f_f == bauer) && (xp->f_c == enemy) ) { /* B-block */ if( v2 = fig_moves[xp->f_idx] ) { if( LIN64(tp->f_pos64) == epromlin ) { v -= ((v2 >= 4) ? 4 : v2); }else { v -= 1; } } } } #endif cur_king_escs = escs; v -= bitsum[escs]; if( SET1(mp->m_idx) & does1d ) { /* take away singly covered */ cur_king_escs |= fig_cov[fp->f_f][fp-ekp] & noescs1d; } cur_king_escs &= ~fig_cov[mp->m_fig][tp-ekp]; v += bitsum[cur_king_escs]; /* # of att king moves */ if( v <= 0 ) v = 1; v2 = v; #if CHK_B_BLOCK { register const Field* xp; xp = fp - ebaumov; if( (xp->f_f == bauer) && (xp->f_c == enemy) ) { if( LIN64(fp->f_pos64) == epromlin ) { v += 4; /* 4 promotions enabled */ v2 += 38/v; /* MRFC */ }else { v += 1; /* ca 1 B-move enabled */ v2 = v; } } } #endif /* * Ok, this 'v' is the basis for the next two levels. */ v2 = V2_VAL(v2); VV(printf("> %2o-%2o %d->%d: v=%3d, v2=%3d\n", fp->f_pos64, tp->f_pos64, fp->f_f, mp->m_fig, v, v2);) if( mp->m_attr & MA__CK ) { /* move says 'check' */ /* * A checking move is potentially good, as it severely * handicaps the attacker. But, we want to distinguish * carefully between good and not so good or even foolish * checking moves. * * We start off with the 'cur_king_escs'. * We test, whether the enemy can beat back. * Then, if not in double check, we enumerate blocking moves, * and beating moves, and compute a weighted average. */ int dir_dkp_tp; int beat_fig_val; int risk; /* how risky is this move? */ int in_ck; int k_moves; int beat_cnt; int block_cnt; int k_beat_cnt; int sav_v2; sav_v2 = v2; beat_fig_val = 0; in_ck = 0; risk = 0; beat_cnt = 0; block_cnt = 0; k_beat_cnt = 0; k_moves = v = bitsum[cur_king_escs]; /* # of att king moves */ if( k_moves <= 0 ) k_moves = 1; if( (F_DATT(tp) & emask & BOTH_KINGS) && ((F_DATT(tp) & self_mask & ~SET1(mp->m_idx)) == 0) ) { ++v; /* K beat back */ ++beat_cnt; k_beat_cnt = 1; } if( (mp->m_attr & (MA_ICK|MA_DCK)) != (MA_ICK|MA_DCK) ) { register Xconst Field* xp; register int xdelta; register rPieceSet eatts; int xxx; /* * check blocking moves: * on tp --> ekp */ if( (mp->m_attr & MA_DCK) && (mp->m_fig != springer) ) { eatts = emask & ~BOTH_KINGS; xp = tp; if( mp->m_fig == koenig ) { /* 0-0 or 0-0-0 */ xdelta = (mp->m_from - mp->m_to) / 2; xp += xdelta; /* here T gives check */ } xdelta = dam_mov[att_dir(xp, ekp)]; while( (xp += xdelta) != ekp ) { if( F_DATT(xp) & eatts ) { v++; block_cnt++; } } } /* * analyse non K beat back */ eatts = F_DATT(tp) & emask & ~BOTH_KINGS; dir_dkp_tp = att_dir(dkp, tp); for( ; eatts ; CLR_LOW_BIT(eatts) ) { const Field* ap; PieceSet s; ++v; ++beat_cnt; /* * test if defender can beat back * with check. */ if( !in_ck && ((s = ck_fig_set & F_DATT(tp) & ~SET1(mp->m_idx))) && fig__can_dir(bp, s, att_dir(tp, ekp)) ) { continue; } ap = fig__pos(bp, LOW_BIT(eatts)); xxx = bitsum[fig_cov[ap->f_f][tp - dkp]] - bitsum[fig_cov[ap->f_f][ap - dkp]]; if( depth >= 5 ) { v += xxx * 2; risk += xxx * 2; }else { v += xxx * 2; risk += xxx; } if( no_dir(dir_dkp_tp) ) continue; /* * analyse if there is a check * from tp --> dkp */ switch(ap->f_f) { case springer: if( spr_dir(dir_dkp_tp) ) { beat_fig_val += ATT_VALUE(ap->f_f,depth-1); in_ck++; } break; case laeufer: if( lfr_dir(dir_dkp_tp) ) { goto ltd_dir; } break; case turm: if( trm_dir(dir_dkp_tp) ) { goto ltd_dir; } break; case dame: if( ! dam_dir(dir_dkp_tp) ) { /* 12.04.2008 */ break; } ltd_dir: /* * test dkp --> tp */ xdelta = dam_mov[dir_dkp_tp]; xp = dkp; do { xp += xdelta; } while ((xp->f_c == empty || xp==fp) && xp!=tp); if( xp == tp ) { in_ck++; beat_fig_val += ATT_VALUE(ap->f_f,depth-1); } break; } } /* end "for ( ; eatts ; )" */ } /* end if (say singly check) */ #define SET_MOVES_ON_V2(max_esc,ck_again,nxt_esc) \ if( ck_figs > 1 ) { \ v2 = (nxt_esc); \ }else { \ v2 = (( ((ck_again)*(nxt_esc)) \ + (((max_esc)-(ck_again))*sav_v2) \ ) / (max_esc)); \ } switch( mp->m_fig ) { case dame: v2 = 3; break; case turm: v2 = 5; break; case laeufer: SET_MOVES_ON_V2(k_moves,2,7); break; case springer: SET_MOVES_ON_V2(k_moves,3,7); break; default: v2 = 8; } if( !in_ck ) { if( risk <= 2 ) { have_good_ck = 1; } }else { if( F_DATT(tp) & self_mask & ~SET1(mp->m_idx) ) { /* covered */ beat_fig_val = beat_fig_val / in_ck; }else { beat_fig_val = 0; } } v2 = ( (k_moves * v2) + ((beat_cnt-in_ck-k_beat_cnt) * ((ck_figs>1 && !in_ck) ? k_moves : sav_v2)) + (in_ck * att_moves) + (k_beat_cnt * sav_v2) + (block_cnt * (k_moves-1)) #if OWN_V_RES + (beat_cnt * (OWN_VALUE(mp->m_fig,depth)+1)) #else + (beat_cnt * (OWN_VALUE(fp->f_f,depth)+1)) #endif ) / (k_moves + beat_cnt + block_cnt); if( tp->f_c != empty ) { v2 -= ATT_VALUE(tp->f_f, depth-1); } v -= beat_fig_val; v2 -= beat_fig_val; } /* end if (say check) */ if( tp->f_c != empty ) { /* beats some attacker */ if( F_IATT(dkp) & SET1(tp->f_idx) ) { v -= 1; /* which pins someone to defender K */ if( F_DATT(fp) & SET1(tp->f_idx) ) { v -= 2; } } } { register rPieceSet mask; mask = F_DATT(tp) & emask; if( mask ) { /* beat back */ /* * king may only beat back * if fig not covered */ if( (mask & ~BOTH_KINGS) == 0 ) { if( (F_DATT(tp) & self_mask & ~SET1(mp->m_idx)) == 0 ) { #if OWN_V_RES v2 += OWN_VALUE(mp->m_fig,depth); #else v2 += OWN_VALUE(fp->f_f,depth); #endif } }else { #if OWN_V_RES v2 += OWN_VALUE(mp->m_fig,depth); #else v2 += OWN_VALUE(fp->f_f,depth); #endif } } #if 0 /* doesn't improve, FFS */ if( mp->m_fig != fp->f_f ) { /* promotion */ v2 -= 1 + OWN_VALUE(mp->m_fig,depth); v2 += OWN_VALUE(fp->f_f ,depth); v -= 1; } #endif /* * analyse escape situation of defenders king */ if( !have_good_ck ) { if( mp->m_fig == koenig ) { register int b; register int i; mask = emask; if( tp->f_c != empty ) { mask &= ~SET1(tp->f_idx); } for( i=MIN_D_DIR ; if_c == enemy) || (xp->f_c == empty)) ) { v += 1; } xp = tp + dam_mov[i]; if( ((xp==fp) || (xp->f_c==enemy) || (xp->f_c==empty)) && !(F_DATT(xp) & mask) ) { v -= 1; } } b = pos64_borders[fp->f_pos64] - pos64_borders[tp->f_pos64]; if( b ) { if( b > 0 ) v--; else v++; } }else { if( F_DATT(fp) & dkatt ) { v -= 1; } if( F_DATT(tp) & dkatt ) { v += 1; } } } } if( v <= 0 ) v = 1; if( v2 <= 0 ) v2 = 1; mp->m_value = v; mp->m_value2 = v2; VV(printf("< %2o-%2o %d->%d: v=%3d, v2=%3d\n", fp->f_pos64, tp->f_pos64, fp->f_f, mp->m_fig, v, v2);) } /* end formoves */ /* * 'fig_moves' is now complete for both sides. */ if( !have_good_ck || (depth >= 6) ) { /* * We suspect, that the analysis up to now is not good enough, * or we have just time enough to continue... */ find_chk_nxt(depth, bp, lp, fig_moves, ck_fig_set, escs, noescs1d, does1d); VV( formoves(lp, mp) { fp = &(bp->b_f[mp->m_from]); /* from, move source */ tp = &(bp->b_f[mp->m_to]); /* to , move destination */ printf("C %2o-%2o %d->%d: v=%3d, v2=%3d\n", fp->f_pos64, tp->f_pos64, fp->f_f, mp->m_fig, mp->m_value, mp->m_value2); } ) try_promotion(depth, bp, lp, fig_moves, ck_fig_set, escs, noescs1d, does1d); } /* * Scan the move list again, compute the value product, * negate it, and normalise it. */ v = att_moves * V2_VAL(att_moves); /* sort of average */ formoves(lp, mp) { mp->m_value = v - (mp->m_value * mp->m_value2); } ml_sort_rdx(lp); #if 0 if( !have_good_ck ) { int last = 0; int v; int vv; int i; int max; int min; int a[100]; register Move* p; double d; v = lp->l_m[0].m_value; vv = v/3; if( vv < 2 ) vv = 2; v -= vv; if( v >= 6 ) v = 6; formoves(lp, p) { if( p->m_value >= v ) last++; else break; } if( (last == 1) && (lp->l_m[1].m_value >= 3) ) last = 2; if( last > 1 ) { if( last > 6 ) last = 6; for( i = 0, p = lp->l_m ; i < last ; i++, ++p ) { Movelist ml; clear_list(&ml); move_execute(bp, p); move_gen(bp, &ml); a[i] = list_length(&ml); move_undo(bp); } max = 0; min = 9999; for( i = 0 ; i < last ; i++ ) { if( a[i] > max ) max = a[i]; if( a[i] < min ) min = a[i]; } /* * give 5 points for the best. */ #define PKT 5.0 if( max != min ) { Move* sav_free; d = PKT / (double) (max - min); for( i = 0, p = lp->l_m ; i < last ; ++i, ++p ) { p->m_value += (int) (PKT - (double)(a[i] - min) * d); } sav_free = lp->l_free; lp->l_free = &lp->l_m[last]; ml_sort_rdx(lp); lp->l_free = sav_free; } } } #endif #if 0 && HAS_INTERFACE if( f_ic && (f_no_trc == 0) && !f_ic_skip ) { /* * For the first 5 moves enter the real effort (in moves) into "value2" */ Counter sav_mov; int i; i = 0; f_no_trc = 1; formoves(lp, mp) { mp->m_value2 = 0; if( i < 5 && mp->m_value ) { int res; move_execute(bp, mp); sav_mov = sc_move_exec; res = ANASUC(analyse( bp, depth-1, (Movelist*)0, (Move*)0, (RefuList*)0)); move_undo(bp); mp->m_value2 = sc_move_exec - sav_mov; if( res ) { mp->m_value2 = -mp->m_value2; } } ++i; } f_no_trc = 0; } #endif return 4; /* apx. cost */ }