ephemeral_shade

BASIC詰将棋局面生成プログラム試作品

Feb 18th, 2017
692
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. !  Read me/このプログラムを使用する前に
  2. !  This program was made by Ephemeral_shade.
  3. !  This is for automatic generation  of checkerboard for Shogi problem.
  4. !  Some comments by me that have been left in this program in some places are may goodness for you.
  5. !  And that is the line that starts with an exclamation mark like this.
  6. !  Perhaps,this program has some bug and so on.
  7. !  If it's true,please allow me.
  8. !  Thanks.
  9. !  このプログラムはEphemeral_shadeによって作成されました。
  10. !  これは詰将棋用局面を自動で生成するものです。(但、完成品が出力されるのではなく、このプログラムでは詰むかどうかすらわからない局面の生成のみ行うことに注意してください。)
  11. !  出来るだけプログラムの中にコメントを残しました。
  12. !  これらの行のように、エクスクラメーションマークで始まる行がコメントの文です。
  13. !  恐らく、このプログラム未知のバグを持っているでしょう。
  14. !  もしそうでも許してください。
  15. !  プログラムの改良などは歓迎です。よろしければ作者にも更新内容を共有して頂けると飛んで喜びます。
  16. !  はじめに
  17. !  棋譜出力用タイプは.csaを用いている。
  18. !  解答用プログラム迄はこの形式のままで進み、詰将棋的価値の評価の際には.KI2を用いる。
  19. !  色々な問題で完全自動ではなくなってしまうかもしれない。
  20.  
  21. !  ~~  プログラム本文  ~~
  22. !宣言、変数の設定
  23. OPTION BASE 0
  24. CLEAR
  25. LET seed=INT(TIME)
  26. RANDOMIZE seed
  27. DIM ZAHYOU$(12,12)
  28. DIM NIFU(19)
  29.  
  30. SUB main
  31.  
  32. ! CALL ASKrnd
  33.    CALL askrnd
  34.    CALL hensuutyousei
  35.    FOR K=1 TO kyokumensuu
  36.       CALL syokika
  37.       CALL komasuu
  38.       CALL seisei
  39.       CALL motigoma
  40.       CALL syuturyoku
  41.       LET motigoma$=""
  42.       FOR g=1 TO 18
  43.          LET NIFU(g)=0
  44.       NEXT g
  45.       !PRINT k;"/";kyokumensuu
  46.    NEXT K
  47.    PRINT "完了しました。"
  48.    
  49. END SUB
  50.  
  51.  
  52. !駒の種類を選ぶときには乱数を用いるが、飛び道具の使用の有無の設定から、選ばれる可能性のある駒の種類をここで決めている。
  53. !15が小駒で、68が飛び道具に相当する。  
  54. DIM koma(9)
  55.  
  56. SUB seisei
  57. !乱数を用いて座標と置く駒を決める。
  58.  
  59. !玉方の配置には二歩と行き場のない駒に気をつけること
  60. !攻方の配置にはそれに加えて初期配置で王手がかかるような配置をしてもダメ。
  61.  
  62. !まずは玉方の玉を配置する。
  63. !xjougenとyjougenで使えるマス目に上限があることに注意。
  64. !玉の配置。なお、王手検査のため、このx,y座標は保持しておく。
  65. !LET gyx=INT(RND*xjougen+1)
  66. !LET gyy=INT(RND*yjougen+1)
  67.    LET gyx=INT(RND*2)+1
  68.    LET gyy=INT(RND*2)+1
  69.    LET ZAHYOU$(gyx,gyy)="-OU"
  70.    
  71.    FOR i=1 TO sentekoma
  72.       CALL komasyurui
  73.       CALL zahyournd
  74.        
  75.       LET SENGO$="+"
  76.       CALL komasyurui
  77.        
  78.       CALL zahyournd
  79.       CALL haichi
  80.        
  81.    NEXT i
  82.    
  83.    FOR i=1 TO gotekoma
  84.       LET SENGO$="-"
  85.       CALL komasyurui
  86.       CALL zahyournd
  87.       CALL haichi
  88.       LET koma$=" * "
  89.    NEXT i
  90.    
  91. END SUB
  92.  
  93.  
  94. SUB komasyurui
  95.  
  96.    LET kmrnd=INT(RND*kind)+1
  97.    !LET kmrnd=1
  98.    
  99.    IF kmrnd=1 AND koma(1)>=1 THEN LET koma$=SENGO$&"FU"
  100.    IF kmrnd=2 AND koma(2)>=1 THEN LET koma$=SENGO$&"KE"    
  101.    IF kmrnd=3 AND koma(3)>=1 THEN LET koma$=SENGO$&"GI"    
  102.    IF kmrnd=4 AND koma(4)>=1 THEN LET koma$=SENGO$&"KI"    
  103.    IF kmrnd=5 AND koma(1)>=1 THEN LET koma$=SENGO$&"TO"    
  104.    IF kmrnd=6 AND koma(6)>=1 THEN LET koma$=SENGO$&"KY"    
  105.    IF kmrnd=7 AND koma(7)>=1 THEN
  106.       LET narigoma=INT(RND*2)
  107.       IF narigoma=0 THEN LET koma$=SENGO$&"KA" ELSE LET koma$=sengo$&"UM"
  108.    END IF
  109.    IF kmrnd=8 AND koma(8)>=1 THEN
  110.       LET narigoma=INT(RND*2)
  111.       IF narigoma=0 THEN LET koma$=SENGO$&"HI" ELSE LET koma$=SENGO$&"RY"
  112.    END IF
  113.    
  114. END SUB
  115.  
  116.  
  117. SUB zahyournd
  118.    LET komax=INT(RND*xjougen)+1
  119.    LET komay=INT(RND*yjougen)+1
  120. END SUB
  121.  
  122.  
  123. SUB haichi
  124.  
  125.    IF SENGO$="-" THEN
  126.       LET outeok=1
  127.       CALL ikibanonai
  128.       CALL nifu
  129.       IF outeok=1 THEN
  130.          IF ZAHYOU$(komax,komay)=" * " THEN
  131.             LET ZAHYOU$(komax,komay)=koma$
  132.             IF koma$="-FU" THEN LET NIFU(komax+9)=1
  133.             LET koma(komarnd)=koma(komarnd)-1
  134.          ELSE
  135.             IF ZAHYOU$(komax,komay+1)=" * " THEN
  136.                LET ZAHYOU$(komax,komay+1)=koma$
  137.                IF koma$="-FU" THEN LET NIFU(komax+9)=1
  138.                LET koma(komarnd)=koma(komarnd)-1            
  139.             END IF
  140.          END IF
  141.       END IF
  142.    END IF
  143.    
  144.    IF SENGO$="+" then
  145.       IF ZAHYOU$(komax,komay)=" * " THEN
  146.          CALL outekensa
  147.          IF outeok=1 THEN
  148.             LET ZAHYOU$(komax,komay)=koma$
  149.             IF koma$="+FU" THEN LET NIFU(komax)=1
  150.             LET koma(komarnd)=koma(komarnd)-1
  151.          END IF
  152.       END IF
  153.    END if
  154.    
  155.    
  156.    ! PRINT koma$;komax,komay
  157. END SUB
  158.  
  159.  
  160.  
  161.  
  162.  
  163. SUB outekensa
  164.    LET outeok=1
  165.    
  166.    
  167.    CALL ikibanonai
  168.    CALL nifu
  169.    
  170.    ! PRINT koma$;
  171.    
  172.    IF outeok=1 THEN
  173.       IF koma$="+FU" AND (komax=gyx AND komay+1=gyy) THEN LET outeok=0
  174.       IF koma$="+KE" THEN
  175.          IF  ((ZAHYOU$(komax+1,komay-2)="-OU") OR (ZAHYOU$(komax-1,komay-2)="-OU")) THEN LET outeok=0
  176.       END IF
  177.       IF koma$="+GI" THEN
  178.          IF ((ZAHYOU$(komax+1,komay-1)="-OU") OR (ZAHYOU$(komax-1,komay-1)="-OU") OR (ZAHYOU$(komax,komay-1)="-OU") OR (ZAHYOU$(komax-1,komay+1)="-OU") OR (ZAHYOU$(komax+1,komay+1)="-OU"))  THEN LET outeok=0
  179.       END IF
  180.       IF koma$="+KI" OR koma$="+TO" THEN
  181.          IF ((ZAHYOU$(komax+1,komay-1)="-OU") OR (ZAHYOU$(komax-1,komay-1)="-OU") OR (ZAHYOU$(komax,komay-1)="-OU") OR (ZAHYOU$(komax+1,komay)="-OU") OR (ZAHYOU$(komax-1,komay)="-OU") OR (ZAHYOU$(komax,komay+1)="-OU")) THEN LET outeok=0
  182.       END if
  183.        
  184.       IF koma$="+KY" AND komax=gyy AND komay<gyy THEN
  185.          IF komay+1=gyy THEN LET outeok=0
  186.       else
  187.          FOR cky=komay+1 TO gyy STEP -1
  188.             IF ZAHYOU$(komax,cky)="-OU" THEN LET outeok=0
  189.             IF NOT(ZAHYOU$(komax,cky)=" * ") THEN LET cky=gyy
  190.          NEXT cky
  191.          ! IF outeok=0 THEN PRINT "not ok";k;komax;komay;koma$
  192.          
  193.       END if
  194.    END if
  195.    
  196.    
  197.    
  198.    
  199. END SUB
  200.  
  201. SUB ikibanonai
  202.  
  203.    IF (koma$="+FU" OR koma$="+KE" OR koma$="+KY") AND komay=1 THEN LET outeok=0
  204.    IF (koma$="-FU" OR koma$="-KE" OR koma$="-KY") AND komay=9 THEN LET outeok=0
  205.    IF koma$="+KE" AND komay=2 THEN LET outeok=0
  206.    IF koma$="-KE" AND komay=8 THEN LET outeok=0
  207.    
  208. END SUB
  209.  
  210. SUB nifu
  211.    IF koma$="-FU" AND NIFU(komax+9)=1 THEN LET outeok=0
  212.    IF koma$="+FU" AND NIFU(komax)=1 THEN LET outeok=0
  213. END SUB
  214.  
  215. SUB hensuutyousei
  216.    LET xjougen=INT(xjougen)
  217.    LET yjougen=INT(yjougen)
  218.    LET sentekoma=INT(sentekoma)
  219.    LET gotekoma=INT(gotekoma)
  220.    LET motigoma=INT(motigoma)
  221.    LET kyokumensuu=INT(kyokumensuu)
  222.    LET renban=INT(renban)
  223.    IF tobidougu=0 THEN LET kind=5 ELSE  LET kind=8
  224. END SUB
  225.  
  226. SUB komasuu
  227.    LET koma(1)=18
  228.    FOR p=2 TO 6
  229.       LET koma(p)=4
  230.    NEXT p
  231.    LET koma(5)=0
  232.    LET koma(7)=2
  233.    LET koma(8)=2
  234. END SUB
  235.  
  236. SUB syousaisettei
  237. !詳細設定用入力部
  238. END SUB
  239.  
  240. SUB motigoma
  241.    RANDOMIZE
  242.    FOR r=0 TO motigoma
  243.    
  244.    !割合をほんの少し銀に偏らせています。
  245.       LET m=INT(RND*kind)+1
  246.        
  247.       IF m=1 AND koma(1)>=1 THEN LET motigoma$=motigoma$&"00FU"
  248.       IF m=2 AND koma(2)>=1 THEN LET motigoma$=motigoma$&"00KE"
  249.       IF m=3 OR m=5 AND koma(3)>=1 THEN LET motigoma$=motigoma$&"00GI"
  250.       IF m=4 AND koma(4)>=1 THEN LET motigoma$=motigoma$&"00KI"
  251.       IF m=6 AND koma(6)>=1 THEN LET motigoma$=motigoma$&"00KY"
  252.       IF m=6 AND koma(6)>=1 THEN LET motigoma$=motigoma$&"00KY"
  253.       IF m=6 AND koma(6)>=1 THEN LET motigoma$=motigoma$&"00KY"
  254.       IF m=7 AND koma(7)>=1 THEN LET motigoma$=motigoma$&"00KA"
  255.       IF m=8 AND koma(8)>=1 THEN LET motigoma$=motigoma$&"00HI"
  256.       LET koma(m)=koma(m)-1
  257.    NEXT r
  258. END SUB
  259.  
  260. SUB syuturyoku
  261.  
  262.    LET f$=STR$(f)
  263.    LET a$="C:\Program Files (x86)\Kakinoki\KShogi9\"&filename$&f$&".csa"
  264.    OPEN #2:NAME a$
  265.    ERASE #2
  266.    PRINT #2 : "V2.2"
  267.    PRINT #2
  268.    FOR y=1 TO 9  
  269.       FOR x=9 TO 1 STEP -1
  270.          IF x=9 THEN PRINT #2 : "P"&STR$(y);
  271.          IF x=1 THEN PRINT #2 : ZAHYOU$(x,y) ELSE PRINT #2 : ZAHYOU$(x,y);
  272.       NEXT x
  273.    NEXT y
  274.    PRINT #2 : "P+";motigoma$
  275.    PRINT #2 : "P-";
  276.    FOR i=1 TO koma(1)
  277.       PRINT #2 : "00FU";
  278.    NEXT i
  279.    FOR i=1 TO koma(2)
  280.       PRINT #2 : "00KE";
  281.    NEXT i
  282.    FOR i=1 TO koma(3)
  283.       PRINT #2 : "00GI";
  284.    NEXT i
  285.    FOR i=1 TO koma(4)
  286.       PRINT #2 : "00KI";
  287.    NEXT i
  288.    FOR i=1 TO koma(6)
  289.       PRINT #2 : "00KY";
  290.    NEXT i
  291.    FOR i=1 TO koma(7)
  292.       PRINT #2 : "00KA";
  293.    NEXT i
  294.    FOR i=1 TO koma(8)
  295.       PRINT #2 : "00HI";
  296.    NEXT i
  297.    CLOSE #2
  298.    LET f=f+1
  299.    
  300. END SUB
  301.  
  302. SUB askrnd
  303.    LET xjougen=6 !INT(RND*9)+1
  304.    LET yjougen=3 !INT(RND*9)+1
  305.    LET sentekoma=12 !INT(RND*10)+1
  306.    LET gotekoma=6 !INT(RND*10)+1
  307.    LET motigoma=5 !INT(RND*10)+1
  308.    LET tobidougu=0 !INT(RND*2)
  309.    LET kyokumensuu=100
  310.    LET renban=INT(renban)
  311. END SUB
  312. SUB banmenkakunin
  313.    FOR y=1 TO 9  
  314.       FOR x=9 TO 1 STEP -1
  315.          IF x=1 THEN PRINT ZAHYOU$(x,y) ELSE PRINT  ZAHYOU$(x,y)
  316.       NEXT x
  317.    NEXT y
  318. END SUB
  319.  
  320.  
  321. !出力用座標値の初期化用ルーチン
  322. SUB syokika  !このルーチン内のfor文では、x=1の時y=19に空白を意味する" * "を代入している。同様にx=2の時、3の時...として81マス分代入している。
  323.    FOR x=1 TO 9
  324.       FOR y=1 TO 9    
  325.          LET ZAHYOU$(x,y)=" * "
  326.       NEXT y
  327.    NEXT x
  328. END sub
  329.  
  330. !局面生成用初期設定をユーザーに尋ねるルーチン
  331. SUB ASK
  332.    PRINT "小数点以下の入力は切り捨てられます。"
  333.    PRINT "また、条件を満たしていない不正な入力は無視され、再入力が出来ます。"
  334.    PRINT
  335.    PRINT
  336.    INPUT PROMPT "盤面は縦に何マス使う?(3~9)  ":xjougen
  337.    DO UNTIL xjougen>=3 AND xjougen<=9
  338.       PRINT "不正な入力です。入力する数値を確認してもう一度入力してください。"
  339.       PRINT  
  340.       INPUT PROMPT "盤面は縦に何マス使う?(3~9)  ":xjougen
  341.    LOOP      
  342.    PRINT "入力完了"
  343.    PRINT
  344.    INPUT PROMPT "盤面は横に何マス使う?(3~9)  ":yjougen
  345.    DO UNTIL yjougen>=3 AND yjougen<=9
  346.       PRINT "不正な入力です。入力する数値を確認してもう一度入力してください。"
  347.       PRINT        
  348.       INPUT PROMPT "盤面は縦に何マス使う?(3~9)  ":yjougen
  349.    LOOP
  350.    PRINT "入力完了"
  351.    PRINT    
  352.    !LET komajougen=INT(xjougen)*INT(yjougen)/2  
  353.    !使うマス目に合わせて使える駒数の上限を決めようかとも思ったんだけど、実装がフクザツなので後回し。後々実装します。
  354.    INPUT  PROMPT "盤上の攻方の枚数?(1~10)  ":sentekoma
  355.    DO UNTIL sentekoma<=10 AND sentekoma>0
  356.       PRINT "不正な入力です。入力する数値を確認してもう一度入力してください。"
  357.       PRINT
  358.       INPUT  PROMPT "盤上の攻方の枚数?(1~10)  ":sentekoma
  359.    LOOP
  360.    PRINT "入力完了"    
  361.    PRINT
  362.    INPUT  PROMPT "盤上の王を含めない玉方の枚数?(1~10)  ":gotekoma    
  363.    DO  UNTIL gotekoma<=10 AND gotekoma>0
  364.       PRINT "不正な入力です。入力する数値を確認してもう一度入力してください。"
  365.       PRINT
  366.       INPUT  PROMPT "盤上の玉方の枚数?(1~10)  ":gotekoma
  367.    LOOP
  368.    PRINT "入力完了"
  369.    PRINT    
  370.    INPUT  PROMPT "攻方の持駒の枚数?(0~10)  (1~10の範囲でランダム=99)":motigoma    
  371.    DO UNTIL motigoma<=10 AND motigoma>=0 OR motigoma=99
  372.       PRINT "不正な入力です。入力する数値を確認してもう一度入力してください。"      
  373.       PRINT
  374.       INPUT  PROMPT "攻方の持駒の枚数?(0~10) (1~10の範囲でランダム=99) ":motigoma
  375.    LOOP
  376.    PRINT "入力完了"
  377.    PRINT
  378.    INPUT PROMPT "飛道具(飛角香)を使う?(Y=1/N=0)  ":tobidougu    
  379.    DO UNTIL tobidougu=1 OR tobidougu=0
  380.       PRINT "不正な入力です。入力する数値を確認してもう一度入力してください。"  
  381.       PRINT
  382.       INPUT PROMPT "飛道具(飛角香)を使う?(Y=1/N=0)  ":tobidougu
  383.    LOOP
  384.    PRINT "入力完了"
  385.    PRINT
  386.    INPUT PROMPT "局面はいくつ生成する?(1~10000000)":kyokumensuu  
  387.    DO UNTIL kyokumensuu>=1 AND kyokumensuu<10000000
  388.       PRINT "不正な入力です。入力する数値を確認してもう一度入力してください。"
  389.       PRINT
  390.       INPUT PROMPT "局面はいくつ生成する?(1~10000000)":kyokumensuu
  391.    LOOP
  392.    PRINT "入力完了"
  393.    PRINT
  394.    ! PRINT "注意(半角英数字、アンダーバーのみ使用してください。空白やピリオドなどは不具合の原因となり、局面が生成できない恐れがあります。)"
  395.    !  INPUT PROMPT"作成するファイル名は?":filename$
  396.    PRINT "入力完了"
  397.    PRINT
  398.    !  INPUT PROMPT"ファイル連番の初期値は?(0~)":renban
  399.    PRINT "入力完了"
  400.    PRINT
  401.    PRINT "設定"
  402.    print "使用する広さ";INT(xjougen);"*";INT(yjougen)
  403.    PRINT "盤上攻方駒";INT(sentekoma)
  404.    PRINT "玉方駒数";INT(gotekoma)
  405.    PRINT "攻方持駒枚数";INT(motigoma)
  406.    PRINT "飛道具有無";tobidougu
  407.    PRINT "生成局面数";kyokumensuu
  408.    PRINT "連番ファイル名";filename$
  409.    PRINT "連番初期値";renban
  410.    PRINT
  411.    INPUT PROMPT "この設定で生成を始めても良いですか?(Y=1/N=0/詳細設定=524287)":kakunin
  412.    DO UNTIL kakunin=0 OR kakunin=1 OR kakunin=524287
  413.       PRINT "不正な入力です。入力する数値を確認してもう一度入力してください。"
  414.       PRINT
  415.       INPUT PROMPT "この設定で生成を始めても良いですか?(Y=1/N=0/詳細設定=524287)":kakunin      
  416.    LOOP
  417.    IF kakunin=1 THEN  
  418.       PRINT "局面生成を開始します。"
  419.    ELSE
  420.       CALL ASK  
  421.    END IF
  422.    
  423. END SUB
  424.  
  425.  
  426. CALL main
  427. !CALL yodumekensa
  428. SUB yodumekensa
  429.    FOR f=renban TO kyokumensuu
  430.       LET f$=STR$(f)
  431.       LET a$="F:\BASIC局面生成用プログラム\output\"&filename$&f$&".csa"
  432.       PRINT a$
  433.       ! execute "F:\BASIC局面生成用プログラム\output\KShogi9\KShogi9.exe" WITH (a$&" /M2 /Z")
  434.    NEXT f
  435.    
  436. END sub
  437.  
  438.  
  439. END
RAW Paste Data

Adblocker detected! Please consider disabling it...

We've detected AdBlock Plus or some other adblocking software preventing Pastebin.com from fully loading.

We don't have any obnoxious sound, or popup ads, we actively block these annoying types of ads!

Please add Pastebin.com to your ad blocker whitelist or disable your adblocking software.

×