fortran66のブログ

fortran について書きます。

分割をフロベニウス記法へ

分割のヤング図をフロベニウス記法へ

分割 [4,3,3,3,1,1] rank=3
フロベニウス記法 a=(3,1,0)、 b=(5,2,1)

■□□□
□■□
□□■
□□□

その逆も作りましたが、まだ詰め足りないです。途中ということでw(追記:少し直しました)

関数の総称名の作り方もよく分かりません。

実行結果

([3,1,0],[5,2,1])

ソースプログラム

main = print (frobenius [4,3,3,3,1,1]) 
--print (ftop ([3,1,0], [5,2,1]) ) 

type Partition = [Int]
type Frobenius = ([Int], [Int])

frobenius :: Partition -> Frobenius
frobenius xs = (a xs, b xs)
  where
    a :: Partition -> [Int]
    a = a' 1 
    
    a' :: Int -> Partition -> [Int]
    a' _ [] = [] 
    a' k (x:xs) = if (x-k) < 0 then [] 
                               else (x-k): a' (k+1) xs
                        
    b :: Partition -> [Int]                   
    b = a . conjugate 
    
conjugate :: Partition -> Partition
conjugate [] = []
conjugate xs = (length xs): conjugate (filter (>0) (map (\x -> x-1) xs))

conjugate'  :: Frobenius -> Frobenius
conjugate' (x,y) = (y,x) 


--Frobenius to Partition 
ftop :: Frobenius -> Partition
ftop xs = (atop 1 xs) ++ (btop xs)

atop :: Int -> Frobenius -> Partition
atop _ ([],[]) = []
atop i (a:as,b:bs) = (a+i): (atop (i+1) (as,bs) )   

btop :: Frobenius -> Partition
btop = conjugate . btop' 
  where
    btop' :: Frobenius -> Partition
    btop' ([],[]) = []
    btop' (a:as, b:bs) = if (b-length as) <= 0 then []
                       else (b-length as):(btop' (as, bs))  

Fortran 分割からフロベニウス記法 (逆は無し)

Fortran で考えた方が、考えをそのまま書けるので便利です。

実行結果

 3 1 0 : 5 2 1
続行するには何かキーを押してください . . .

ソースプログラム

    module m_young
      implicit none
    contains
      integer function irank(list)
        integer, intent(in) :: list(:)
        do irank = 1, size(list)
          if (list(irank) < irank) exit  
        end do    
        irank = irank -1
      end function irank
      
      function a(list) result(ires)
        integer, intent(in)  :: list(:)
        integer, allocatable :: ires(:)
        integer :: i, n
        n = irank(list)
        allocate(ires(n))
        do i = 1, n
          ires(i) = list(i) - i  
        end do 
      end function a
      
      function b(list) result(ires)
        integer, intent(in) :: list(:)
        integer, allocatable :: ires(:)
        ires = a( conj(list) )
      end function b
    
      function conj(list) result(ires)
        integer, value  :: list(:)
        integer, allocatable :: ires(:), l(:)
        integer :: i
        l = list
        allocate(ires(list(1)))
        do i = 1, list(1)
          ires(i) = size(l)
          l = pack(l - 1, l > 1) 
        end do
      end function conj  
    end module m_young
    
    program Console10
      use m_young
      implicit none
      integer :: i, j, n, nrank
      integer, allocatable :: ll(:)
      ll = [4,3,3,3,1,1]
      print *, a(ll), ':', b(ll)
    end program Console10