結果

問題 No.334 門松ゲーム
ユーザー jjjj
提出日時 2017-02-04 00:32:05
言語 Fortran
(gFortran 13.2.0)
結果
AC  
実行時間 2 ms / 2,000 ms
コード長 1,801 bytes
コンパイル時間 899 ms
コンパイル使用メモリ 28,452 KB
実行使用メモリ 4,380 KB
最終ジャッジ日時 2023-08-25 19:59:07
合計ジャッジ時間 1,026 ms
ジャッジサーバーID
（参考情報） 		judge12 / judge14
このコードへのチャレンジ
（要ログイン）

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 1 ms
4,380 KB
testcase_01 AC 1 ms
4,376 KB
testcase_02 AC 2 ms
4,376 KB
testcase_03 AC 1 ms
4,380 KB
testcase_04 AC 1 ms
4,376 KB
testcase_05 AC 1 ms
4,376 KB
testcase_06 AC 2 ms
4,380 KB
testcase_07 AC 1 ms
4,380 KB
testcase_08 AC 1 ms
4,380 KB
testcase_09 AC 2 ms
4,380 KB
testcase_10 AC 2 ms
4,376 KB
testcase_11 AC 2 ms
4,380 KB
testcase_12 AC 1 ms
4,376 KB
testcase_13 AC 1 ms
4,376 KB
testcase_14 AC 1 ms
4,380 KB
testcase_15 AC 1 ms
4,380 KB
権限があれば一括ダウンロードができます
コンパイルメッセージ
Main.f90:66:30:

     write(cformat(5:9),'(i0)'),size(array)
                              1
Warning: Legacy Extension: Comma before i/o item list at (1)

ソースコード

diff # 

program main
  implicit none
  integer::N,depth=0
  integer::K(12)
  logical::flag
  read *,N
  read *,K(1:N)
  flag = win(K(1:N), depth)
  if(flag.eqv..false.) print '("-1")'
contains
  logical recursive function win(K, depth) result(w)
    integer::K(:)
    integer,allocatable::L(:)
    integer::a,b,c,s,ka,kb,kc, depth
    logical::mask(12)
    s = SIZE(K)
    if(s.le.2) then
       w = .false.
       return
    else
       allocate(L(s-3))
       mask(1:s) = .true.
       do a=1,s-2
          ka = K(a)
          do b=a+1,s-1
             kb = K(b)
             if(kb.eq.ka) cycle
             do c=b+1,s
                kc = K(c)
!print '(i0,":",3(i0,1x),":",3(i0,1x))',depth,a,b,c, ka,kb,kc
                if(.not.is_kadomatsu(ka,kb,kc)) cycle
                mask(a)=.false.
                mask(b)=.false.
                mask(c)=.false.
                L = PACK(K,mask(1:s))
                if(win(L, depth+1).eqv..false.) then
                   w = .true.
                   if(depth.eq.0) then
                      print '(3(i0,1x))', a-1,b-1,c-1
                   end if
                   return
                end if
                mask(c)=.true.
             end do
             mask(b)=.true.
          end do
          mask(a)=.true.
       end do
       w = .false.
    end if
  end function win
  logical function is_kadomatsu(a,b,c) result(k)
    integer::a,b,c
    if(a.eq.b.or.b.eq.c.or.a.eq.b.or. &
         (a.gt.b.and.b.gt.c) .or. &
         (a.lt.b.and.b.lt.c)) then
       k = .false.
    else
       k = .true.
    end if
  end function is_kadomatsu

  subroutine aprinter(array)
    integer*8::array(:)
    character*32::cformat='(i0,     (1x,i0))'
    write(cformat(5:9),'(i0)'),size(array)
    write(*,cformat) array
  end subroutine aprinter
end program main
0