找回密码  加入

AUTOIT CN

搜索
查看: 172|回复: 2

[效率算法] 將多張棋譜整合為1個SGF,並標示下一手的勝率

[复制链接]
发表于 2018-11-27 12:43:33 | 显示全部楼层 |阅读模式
本帖最后由 yangdai 于 2018-11-27 12:50 编辑

為研究ALPHAGO,寫程式將ALPHAGO下過的棋譜整合,方便打譜研究。
這可用來研究特定對手,將對手的棋譜,分黑白匯入,可以看出對手習慣的套路及勝率。


#include <String.au3>
#include <array.au3>


;$PB=_StringBetween("PB[15]", "PB[", "]")
;msgbox(0,0,$PB[0])
;exit


dim  $Sel=""
$Sel = FileOpenDialog("※  選擇棋譜樹  ", @ScriptDir  & "\", "文件 (*.sgf)")
$fileA = FileOpen($Sel, 0)



If $fileA   = -1 Then Exit

Dim $ALLa = StringStripWS(FileRead($fileA),2)
If @error = -1 Then Exit
FileClose($fileA)


$message = "◎  導入子棋譜 (按下 Ctrl 或 Shift 多選 !)"
$var = FileOpenDialog($message, @ScriptDir  & "\", "文件 (*.sgf)", 1 + 4 )

If @error Then
    MsgBox(4096,"","沒有文件!")
Else
    $var = StringReplace($var, "|", ",")
  ;  MsgBox(4096,"", $var)
EndIf
$AryF=stringsplit($var,",")
_ArrayDisplay($AryF)

if  $AryF[0]=1  Then
        _Filein($AryF[1])
else
        for $k=2  to  $AryF[0]
                ;msgbox(0,0,$AryF[1] & "\" &  $AryF[$k])
                ; J msgbox(0,0, $AryF[$k])

                _Filein($AryF[1] & "\" &  $AryF[$k])

        Next
endif


$file1 = FileOpen($Sel, 2)
$char_txt = $Alla
    ;  if   $char_txt>""  then
     FileWrite($file1, $char_txt & @crlf )
    ;      msg($char_txt)
    ;  endif
FileClose($file1)


msgbox(0,  "轉入完成:" ,   $AryF[0]   )

exit

;1    OOOOX
;  -  OOOO(A)(X)
;2    OOOO)
;  -  OOOOA)
;3    OOOO(O)
;     OOOO(X)
;  -  OOOO(O)
;     OOOO(A)
;     OOOO(X)
;4    OOOO(OX)      =1
;  -  OOOO(O   (A)  (X)  )

Func _Filein($f)    ; 插入棋譜  有3種狀態 OOO),OOO(,OOOX
    $var=$f
    $fileB = FileOpen($var , 0)
    If $fileB   = -1 Then Exit
    Local $chars = StringStripWS(FileRead($fileB),2)
    FileClose($fileB)

    ; 註解 勝負
    $PB=_StringBetween($chars, "PB[", "]")
    $PW=_StringBetween($chars, "PW[", "]")
    $RE=_StringBetween($chars, "RE[", "]")
    $CM= "N[" & $RE[0] & "]C[B:" &  $PB[0] & "...W:" & $PW[0] & "]"
   ;$CM= "N[" & $RE[0] & "]"

    $AryB = _StringBetween($chars, ";B[", "]")
    $AryW = _StringBetween($chars, ";W[", "]")

    ; 依據第一手位置  轉換到座標 3
    $B=$AryB[0]
    $XY=mpos($B)
    $AllB=Comb($xy,$AryB,$AryW)

    $Allc=$AllB
    $AryB = _StringBetween($ALLc, ";B[", "]")
    $AryW = _StringBetween($ALLc, ";W[", "]")


    ; 轉換後   依據第一二手位置  鏡射座標
    $B=$AryB[0]
    $v=$B
    $v1= stringleft($v,1)
    $v2= stringright($v,1)
    $n= asc("s") +  asc("a")
    $w1= chr($n-asc($v1))
    $w2= chr($n-asc($v2))
    if $w1=$v2  then
       $W=$AryW[0]
       $v=$W
       $v1= stringleft($v,1)
       $v2= stringright($v,1)
       if  (asc($v1)+asc($v2))<$n   then
           $ALLb=Comb(4,$AryB,$AryW)
         ; msgbox(0,$W,$f)
         ; exit
       endif
    endif

    ;$n = StringInStr($Alla, "(;B[")
    ;$Ary=_Value($ALLa,$n)
    ;
    ;_ArrayDisplay($Ary)
    ;
    ;for $i=0   to  UBound($Ary) -1
    ;    msgbox(0,20,stringmid($Alla,$ary[$i],7))
    ;next

    ; 目的檔 第一手位置
    $ind_a = StringInStr($Alla, "(;B[")
    $ind_b=0

    for $bi=1   to  stringlen($Allb)
        if   stringmid($Allb,$bi,3)=";B["  or   stringmid($Allb,$bi,3)=";W["   then
             $ind_b=$bi
             $b6=stringmid($Allb,$ind_b,6)
             $n=0
             for $ai=$ind_a  to    stringlen($Alla) - 1
                 $a1=stringmid($Alla,$ai,1)
                 $a3=stringmid($Alla,$ai,3)
                 if $a1="(" or   $a1=")"  or $a3=";B["  or $a3=";W["  then
                    $n=$ai
                    exitloop
                 endif
             next
             if $n>0  then
                $ind_a = $n
                if  $a3=";B[" or $a3=";W["  then
                    $a6=stringmid($Alla,$ind_a,6)

                    if  $a6=$b6  then
                        $ind_a=$ind_a+6
                        ContinueLoop
                    else
                        $m=0
                        for  $i=$ind_a to   stringlen($Alla)
                             $a1=stringmid($Alla,$i,1)
                             if  $a1="("  then
                                 $m=$m +  1
                             endif
                             if  $a1=")"  then
                                 $m=$m -  1
                                 if $m=-1  then
                                    exitloop
                                 endif
                             endif
                          Next
                     endif
                     $Alla =  _StringInsert($Alla, ")", $i)

                     $Allb=   "(" & StringRight($allb,   stringlen($Allb)- $ind_b + 1)   & ")("
                     $Allb=  _StringInsert($Allb,$CM,7)

                     $Alla =  _StringInsert($Alla, $allb, $ind_a - 1)
                     ;000111
                     ;000(222)(111)
                ;OK 1
                   ; msgbox(0,3,$Alla)
                   ; Save($Alla)
                     Return 1
                   ; exit
                 else
                     $a6=stringmid($Alla,$ind_a,6)
                     if  $a1=")"   then
                         $Allb= StringRight($allb,  stringlen($Allb)- $ind_b + 1)
                         $Allb=  _StringInsert($Allb,$CM,6)

                         $Alla =  _StringInsert($Alla, $allb, $ind_a - 1)
                     ;OK 1
                         ;000111)
                         ;000111222)
                     ;   msgbox(0,7000,$Alla)
                     ;   Save($Alla)
                         Return 2
                     endif
                     if  $a1="("   then
                         $ary=_Value($ALLa,$ind_a)
                         $n=0
                         for $i=0   to  UBound($ary) - 1
                             $a6=stringmid($Alla,$ary[$i],6)
                             ;msgbox(0,4000,$a6)
                             if  $a6=$b6  then
                                 $n=$ary[$i]
                              ;   msgbox(0,5000,$a6)
                                 exitloop
                             endif
                         next
                         if  $n=0  then
                             $Allb=  "(" & StringRight($allb,   stringlen($Allb)- $ind_b + 1) &  ")"
                             $Allb=  _StringInsert($Allb,$CM ,7)

                             $Alla =  _StringInsert($Alla, $allb, $ind_a - 1)

                         ;OK
                             ;000(111
                             ;000(222)(111
                    ;        msgbox(0,2,$Alla)
                    ;        Save($Alla)
                             Return 3
                          ;  exit
                         else
                             $ind_a=$n + 6
                          ;  $a6=stringmid($Alla,$ind_a,6)
                         endif
                     endif
                 endif
              else
                 msgbox(0,0,"N<0")
              endif
         endif
    next
    return 5
endfunc



func _Value($s,$x)  ; 找到樹頭下每個節點的的起始位置
     $m=0
     Local $avArray[0]

     for  $i=$x  to   stringlen($s)
          $a1=stringmid($s,$i,1)
          $a4=stringmid($s,$i,4)
          if  $a1="("  then
              $m=$m +  1
          endif
          if  $a1=")"  then
              $m=$m -  1
          endif

          if  $a4="(;B[" or $a4="(;W["   then
              if $m=1   then
                 _ArrayAdd($avArray, $i+1)
               ;  msgbox(0,1,$a4)
              endif
           ;  msgbox(0,0,$a4)
          endif
     Next
     return $avArray
endfunc


;============================================================================== 20170602
func mpos($v)       ; 旗子在棋盤的方位 1234    第一手放在3 第2手放在 下右
     $r=0                             ;5678
     $v1= stringleft($v,1)
     $v2= stringright($v,1)
     $n= asc("s")+  asc("a")
     $w1= chr($n-asc($v1))
     $w2= chr($n-asc($v2))

     ;1234567890123456789      1234
     ;abcdefghijkLmnopqrs      5678


     select
        case $v1>="j"  and   $v2<="j"  and  $w1>=$v2
             $r=3
        case $v1>="j"  and   $v2>="j"  and  $w1>=$v2
             $r=3
        case $v1>"j"   and   $v2<="j"  and  $w1<=$v2
             $r=4
        case $v1>="j"  and   $v2>="j"  and  $v2>=$v1
             $r=7
        case $v1>="j"  and   $v2>="j"  and  $v2<=$v1
             $r=8
        case $v1<="j"  and   $v2<="j"  and  $v1<=$v2
             $r=1
        case $v1<="j"  and   $v2<="j"  and  $v1>=$v2
             $r=2
        case $v1<"j"   and   $v2>="j"  and  $w2>=$v1
             $r=5
        case $v1<"j"   and   $v2>="j"  and  $w2<=$v1
             $r=6
     endselect
      If $R=0  Then
        msgbox(0,$R,$v)
         exit
      endif
     return $r
endfunc


func conv($s,$m)            ; 轉換位置
     $v1= stringleft($s,1)
     $v2= stringright($s,1)
     $n= asc("s")+  asc("a")
     $w1= chr($n-asc($v1))      ; R-L   12 + 34
     $w2= chr($n-asc($v2))      ; D-U   56   78

     $r=  $v1 &   $v2
     select
            case $m=1
                 $r=  $w2  & $v1
            case $m=2
                 $r=  $w1  & $v2
            case $m=3
                 $r=  $v1  & $v2
            case $m=4
                 $r=  $w2  & $w1
            case $m=5
                 $r=  $v2  & $v1
            case $m=6
                 $r=  $w1  & $w2
            case $m=7
                 $r=  $v1  & $w2
            case $m=8
                 $r=  $v2  & $w1
     endselect
     return $r
endfunc



func Comb($m,$ba,$wa)  ; 結合為字串 並轉位置
     $r=""
     for  $i=0 to   UBound($wa)-1
           if   mod($i, 8)=0  then
                $r=$r & ";B["  &  conv($ba[$i],$m)  &  "];W["   &  conv($wa[$i],$m)  &  "]" & @crlf
           else
               $r=$r & ";B["  &  conv($ba[$i],$m)  &  "];W["   &  conv($wa[$i],$m)  &  "]"
           endif
     next
  ;  $r=$r &  ")"
     return $r
endfunc

func msg($s)
     msgbox(0,0,$s)
     return ""
endfunc


func save($s)
      $file3 = FileOpen($Sel, 2)
      $char_txt = $s
       if   $char_txt>""  then
            FileWrite($file3, $char_txt & @crlf )
        ;    msg($char_txt)
      endif
      FileClose($file3)
endfunc
 楼主| 发表于 2018-11-27 13:15:08 | 显示全部楼层
今天中午不休息,看我范大將軍橫刀立馬一竿清台。
发表于 2018-11-27 20:50:45 | 显示全部楼层
本帖最后由 lpxx 于 2018-11-28 03:02 编辑

围棋爱好者?
您需要登录后才可以回帖 登录 | 加入

本版积分规则

QQ|小黑屋|手机版|AUTOIT CN ( 鲁ICP备15028933号-3 )谷歌 百度

GMT+8, 2018-12-15 09:02 , Processed in 0.082397 second(s), 14 queries .

Powered by Discuz! X3.4 Licensed

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表