Standard Young Tableaux

標準ヤング盤の生成を考えます。以前、整数の分割を行いましたが、それはヤング図に対応しています。その時と似たようなやり方を取ることにして、配列をスタックのように用います。
あまりよく考えていないので、まだ冗長かと思います。この先、半標準ヤング盤や歪ヤング盤も扱いたいので、最小限度まで削っていません。ロビンソン-シェーンステッド対応も生成したいところです。また生成順序も乱れているので、データをソートしたいところでもあります。

出力結果

λ

= 1

λ

= 2

λ

= 3

λ

= 4

ソース・プログラム

整数の分割の時は [integer::] のようにして空配列を生成しましたが、今回 [t_box::] では派生型の空配列は生成できなかったので、allocate(list(0)) で明示的に確保しています。

module m_syt
  implicit none
  type :: t_box
    integer :: k, ix, iy
  end type t_box
contains
  subroutine init_board(board)
    integer :: board(0:, 0:)
    board = huge(0)
    board(0, :) = 0
    board(:, 0) = 0
    return
  end subroutine init_board

  recursive subroutine syt(list, n, k, board)
    type(t_box), intent(in) :: list(:)
    integer, intent(in) :: n, k
    integer, intent(in out) :: board(0:, 0:)
    integer :: ix, iy
    if (n + 1 == k) then
!      print '(*(:"[" i2, "](" i2, "," i2, ") "))', list
      write(9, *) list
      return
    end if
    do ix = 1, n
      do iy = 1, n
        if (board(ix, iy) /= huge(0)) cycle
        if (board(ix - 1, iy) < k .and. board(ix, iy - 1) < k) then
          board(ix, iy) = k
          call syt([list, t_box(k, ix, iy)], n, k + 1, board)
          board(ix, iy) = huge(0)
        else
          exit
        end if
      end do
    end do
    return
  end subroutine syt

  subroutine pr_young_tableau(n)
    implicit none
    integer, intent(in) :: n
    type(t_box), allocatable :: list(:)
    integer, allocatable :: tableau(:, :)
    integer :: io, i
    allocate( list(n), tableau(n, n) )
    do 
      read(9, *, iostat = io) list
      if (io == -1) exit
      tableau = 0
      do i = 1, size(list)
        tableau(list(i)%ix, list(i)%iy) = i !list(i)%k
      end do
      do i = 1, n
        if ( all(tableau(i, :) == 0) ) exit
        write(*, '(*(i2))') pack(tableau(i, :), tableau(i, :) /= 0)
      end do
      write(*, *)
    end do    
    return
  end subroutine pr_young_tableau
end module m_syt

program test
  use m_syt
  implicit none
  integer, parameter :: n = 4
  integer, allocatable :: board(:, :)
  type(t_box), allocatable :: list(:)

  allocate( board(0:n, 0:n), list(0) )
  call init_board(board)
  call syt(list, n, 1, board)
  rewind(9)
  call pr_young_tableau(n)
  stop
end program test

結果　補足

λ

= 5

 1 2 3 4 5
  
 1 2 3 4
 5
 
 1 2 3 5
 4
 
 1 2 3
 4 5
 
 1 2 3
 4
 5
 
 1 2 4 5
 3
 
 1 2 4
 3 5
 
 1 2 4
 3
 5
 
 1 2 5
 3 4
 
 1 2
 3 4
 5
 
 1 2 5
 3
 4
 
 1 2
 3 5
 4
 
 1 2
 3
 4
 5
 
 1 3 4 5
 2
 
 1 3 4
 2 5
 
 1 3 4
 2
 5
 
 1 3 5
 2 4
 
 1 3
 2 4
 5
 
 1 3 5
 2
 4
 
 1 3
 2 5
 4
 
 1 3
 2
 4
 5
 
 1 4 5
 2
 3
 
 1 4
 2 5
 3
 
 1 4
 2
 3
 5
 
 1 5
 2
 3
 4
 
 1
 2
 3
 4
 5