DouKaku? Language detail: FORTRAN

マルバツゲーム：賢いプレイヤー (Nested Flatten)

　Wikipediaの完勝手順を参考に，以下の形で実装してみました。

1. 3マス揃う場合には揃える
2. 敵方にリーチが掛かっている場合には阻止する
3. ダブルリーチが掛けられる場合には掛ける
4. 敵方がダブルリーチを掛けられる場合には，以下の方法で阻止する
4-1. 敵方のダブルリーチを阻止できる形でリーチを掛けられる場合にはリーチを掛ける
4-2. 4-1以外の場合は，直接的にダブルリーチを阻止する
5. 中央が開いていれば中央に置く
6. 敵方の角の反対が空いていれば，その角に置く
7. 角が空いていれば角に置く
8. 1～7のいずれにも該当しない場合には，空いているマスに置く

　以下実行結果です。

1> c(tic_tac_toe).
{ok,tic_tac_toe}
2> tic_tac_toe:start().
first:0,second:8762,draw:1238
ok
3> tic_tac_toe:start({fun tic_tac_toe:clever_choice/2,fun tic_tac_toe:random_choice/2}).
first:9573,second:0,draw:427
ok
4> tic_tac_toe:start({fun tic_tac_toe:clever_choice/2,fun tic_tac_toe:clever_choice/2}).
first:0,second:0,draw:10000
ok

see: Wikipedia

-module(tic_tac_toe).
-import(io).
-import(lists).
-import(random).
-export([start/0,start/1,random_choice/2,clever_choice/2]).

create_board() -> lists:map(fun(_) -> 0 end,lists:seq(1,9,1)).

enemy(P) -> P rem 2 + 1.

move(B,1,{C,_}) -> move(B,1,C);
move(B,2,{_,C}) -> move(B,2,C);
move(B,P,C) ->
    PS = C(B,P),
    lists:sublist(B,PS - 1) ++ [P|lists:sublist(B,PS + 1,length(B) - PS)].

check_pattern() ->
    lists:map(fun(X) -> lists:seq(X,X+6,3) end, lists:seq(1,3,1)) ++
    lists:map(fun(X) -> lists:seq(X,X+2,1) end, lists:seq(1,7,3)) ++
    [lists:seq(1,9,4),lists:seq(3,7,2)].

check(B,P) ->
    lists:any(
        fun(PT) ->
            lists:all(
                fun(ST) -> ST == P end,
                lists:map(fun(X) -> lists:nth(X,B) end, PT)
            )
        end,
        check_pattern()
    ).

process(B,P,C) ->
    BN = move(B,P,C),
    R = check(BN,P),
    D = lists:all(fun(ST) -> ST /= 0 end, BN),
    if
        R -> P;
        D -> 0;
        true -> process(BN, enemy(P), C)
    end.

process(C) -> process(create_board(),1,C).

random_choice(B,_) ->
    S = lists:map(fun({PS,_}) -> PS end, lists:filter(fun({_,X}) -> X == 0 end, lists:zip(lists:seq(1,length(B),1),B))),
    lists:nth(random:uniform(length(S)),S).

will_complete(B,P,PL) ->
    lists:filter(
        fun(SL) ->
            (length(lists:filter(fun({_,S}) -> S == P end, SL)) == 2) and
            (length(lists:filter(fun({_,S}) -> S == 0 end, SL)) == 1)
        end,
        lists:map(
            fun(PP) -> lists:map(fun(PS) -> {PS,lists:nth(PS,B)} end, PP) end,
            PL
        )
    ).

proposed_complete(B,P,PL) ->
    lists:map(
        fun(SL) ->
            {PS,_} = lists:nth(1, lists:filter(fun({_,S}) -> S == 0 end, SL)),
            PS
        end,
        will_complete(B,P,PL)
    ).

check_fork(B,P) -> length(will_complete(B,P,check_pattern())) >= 2.

lookahead(F,B,P) ->
    lists:filter(
        F,
        lists:map(
            fun({PT,_}) ->{PT,lists:sublist(B,PT - 1)++[P|lists:sublist(B,PT + 1,length(B) - PT)]} end,
            lists:filter(fun({_,S}) -> S == 0 end, lists:zip(lists:seq(1,9,1),B))
        )
    ).

proposed_fork(B,P,_) ->
    lists:map(
        fun({PS,_}) -> PS end,
        lookahead(fun({_,BP}) -> check_fork(BP,P) end,B,P)
    ).

proposed_block_fork(B,P,PL) ->
    FL = proposed_fork(B,enemy(P),PL),
    F = length(FL),
    if
        F == 0 -> [];
        true ->
            lists:map(
                fun({PS,_}) -> PS end,
                lookahead(
                    fun({_,BP}) ->
                        (length(lists:subtract(proposed_complete(BP,P,check_pattern()),FL)) > 0) or
                        (length(proposed_fork(BP,enemy(P),[])) == 0)
                    end,
                    B,
                    P
                )
            )
    end.

proposed_opposite(B,P,PL) ->
    lists:filter(
        fun(PS) -> lists:nth(PS,B) == 0 end,
        lists:map(
            fun({EP,_}) ->
                {_,OP} =
                    lists:nth(1,
                        lists:filter(
                            fun({CP,_}) -> CP == EP end,
                            lists:zip(PL,lists:map(fun(X) -> 10 -X end, PL))
                        )
                    ),
                OP
            end,
            lists:filter(
                fun({_,S}) -> S == enemy(P) end,
                lists:zip(PL,lists:map(fun(PT) -> lists:nth(PT,B) end, PL))
            )
        )
    ).

proposed_space(B,_,PL) -> lists:filter(fun(PS) -> lists:nth(PS,B) == 0 end, PL).

clever_choice(B,P) ->
    lists:nth(
        1,
        lists:append(
            lists:map(
                fun({F,PP,PL}) -> F(B,PP,PL) end,
                [    {fun proposed_complete/3,P,check_pattern()},
                    {fun proposed_complete/3,enemy(P),check_pattern()},
                    {fun proposed_fork/3,P,[]},
                    {fun proposed_block_fork/3,P,[]},
                    {fun proposed_space/3,0,[5]},
                    {fun proposed_opposite/3,P,[1,3,7,9]},
                    {fun proposed_space/3,0,[1,3,7,9]},
                    {fun proposed_space/3,0,[2,4,6,8]}
                ]
            )
        )
    ).

start(C) ->
    R = lists:map(fun(_) -> process(C) end,lists:seq(1,10000,1)),
    io:format("first:~w,second:~w,draw:~w~n",lists:map(fun(P) -> length(lists:filter(fun(X) -> X == P end, R)) end,[1,2,0])).

start() -> start({fun random_choice/2,fun clever_choice/2}).

ワーカスレッドを安全に終了させるまで待機 (Nested Flatten)

FORTRAN / OpenMP で。
15行で明示的に 8 threads 生成
18行で空きスレッドに仕事を割り当て
22行で NOWAIT 指定によりスレッド間同期を取らずに先へ
24行で全てのスレッドの終了待ち、
ってところです。

スレッドプールの管理は OpenMP に任せきりですが、通常の実装ではスレッドプールは残される、んではないかと。
# OpenMP の仕様を読みきれていない....

      subroutine random_wait(i)
      integer omp_get_thread_num, omp_get_num_threads
      j=mod(irand(),10)
      write(*,'(AI2AI2AI2AI2)') 'begin ',i,' - ',j,' sec, thread ',
     c     omp_get_thread_num(), '/', omp_get_num_threads()
      call sleep(j)
      write(*,'(AI2AI2AI2AI2)') 'end   ',i,' - ',j,' sec, thread ',
     c     omp_get_thread_num(), '/', omp_get_num_threads()
      end

      program thread_test
      integer omp_get_thread_num, omp_get_num_threads
      write(*,*) 'Single Thread'
      call sleep(4)
!$OMP PARALLEL NUM_THREADS(8)                                                   
      write(*,'(AI2AI2)') 'Multi Thread ',
     c     omp_get_thread_num(),'/',omp_get_num_threads()
!$OMP DO SCHEDULE(DYNAMIC)                                                      
      do i=1,20
         call random_wait(i)
      end do
!$OMP END DO NOWAIT                                                             
      write(*,'(AI2)') 'finish', omp_get_thread_num()
!$OMP BARRIER                                                                   
!$OMP MASTER                                                                    
      write(*,*) 'Finish'
!$OMP END MASTER                                                                
!$OMP END PARALLEL                                                              
      end

ピラミッドを作る (Nested Flatten)

もっとシンプルな書き方があったら教えてください。

program main
      call pyramid(1)
      write(*,*)
      call pyramid(2)
      write(*,*)
      call pyramid(3)
      write(*,*)
      call pyramid(4)
      write(*,*)
      call pyramid(5)
      end

      subroutine pyramid(height)
      integer width, height, w
      w = (height - 1)
      width = w * 2 + 1
      do i = 1, height
         call draw(' ', w - i + 1)
         call draw('*', i - 1)
         write(*, '(a$)') '*'
         call draw('*', i - 1)
         call draw(' ', w - i + 1)
         write(*,*)
      end do
      end

      subroutine draw(c, count)
      character c
      integer count
      do i=1, count
         write(*, '(a$)') c
      end do
      end

与えられた数字のケタ数 (Nested Flatten)

なんかFortranがようやく分かってきた。

    INTEGER i
    INTEGER keta

    read(*, *) i
    keta = INT(ALOG10(FLOAT(i))) + 1
    write(*, *) '桁数:', keta, ' 最大桁:', 10 ** (keta - 1)

    end

九九の表示 (Nested Flatten)

初めてのFortranです><
なんか1行目のインデントが効いていないけどタブが存在してます。

do i = 1, 9
        do j = 1, 9
            write(*, 100) i, j, i * j
        end do
    end do

100    format(i1, ' + ', i1, ' = ', i2)

    end

Hello, world! (Nested Flatten)

FORTRAN-77。これまた、懐かしい。。。 7桁目から書き始めます。

1
2
3

C234567
      WRITE(*,*) '簡単なプログラム'
      END

DouKaku?

Language detail: FORTRAN

Unsolved challenges

codes

Index

Feed

Other

Link

Pathtraq