/
tableau.hs
92 lines (73 loc) · 3.17 KB
/
tableau.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
-- Module : YoungCalculus (Representation Theoretic Operations on Young Diagrams and Tableau)
-- Copyright : (c) 2012 Grant Rotskoff
-- License : GPL-3
--
-- Maintainer : gmr1887@gmail.com
-- Stability : experimental
-- Displaying the standard tableau, various parts of the young diagram calculus
module Tableau where
import Partitions
import Sn
import Matrix
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.List
import Data.Maybe
newtype YoungTableau = YT [[Int]] deriving (Eq)
instance Show YoungTableau where
show (YT []) = ""
show (YT (x:xs)) = show x ++ "\n" ++ show (YT xs)
standardTableau :: Partition -> YoungTableau
standardTableau (Part a) = YT $ tile (Part a) [1..(sum a)]
tile :: Partition -> [Int] -> [[Int]]
tile (Part []) _ = []
tile (Part (x:xs)) a = [take x a] ++ (tile (Part xs) (drop x a))
actBy :: Permutation -> YoungTableau -> YoungTableau
actBy (Perm a) (YT t) = YT $ map (map (a Map.!)) t
rowStandard :: YoungTableau -> Bool
rowStandard (YT a) = (map (Set.toList . Set.fromList) a) == a
columnStandard :: YoungTableau -> Bool
columnStandard (YT []) = True
columnStandard (YT a) = rowStandard (YT $ [map (flip (!!) 0) a]) && columnStandard remains where
remains = YT $ filter (not . null) $ map tail a
-- A filter for standard tableau
isStandard :: YoungTableau -> Bool
isStandard a = rowStandard a && columnStandard a
-- Distance is defined in terms of content
content :: YoungTableau -> Int -> Int
content (YT t) i = ci - ri where
ri = fromJust $ findIndex (elem i) t
ci = fromJust $ elemIndex i (t !! ri)
-- The distance between entries in Tableaux
dist :: Int -> Int -> YoungTableau -> Int
dist i j t = (content t j) - (content t i)
-- Young's Orthogonal Representation
yor :: Permutation -> Partition -> [[Double]] --Irrep
yor tau p
| tau == (s (size tau) !! 0) = identityMatrix (dim p)
| otherwise = foldr1 multColumnMatrix $ map (\i -> yorSimple i p) (map head $ toAdjacent tau)
yorSimple :: Int -> Partition -> [[Double]]
yorSimple i (Part p) = [fromVec $ yorColumn [i,i+1] (fromIntegral ci) t |
(ci,t) <- zip [0..((dim (Part p))-1)] (standard $ Part p)] where
order = sum p
yorColumn :: [Int] -> Int -> YoungTableau -> (Vector Double)
yorColumn [i,j] ci (YT t)
| isStandard tauT = makeSparseVec [(fromIntegral ci,d_tt),(tauIndex,d_it)] drho
| otherwise = makeSparseVec [((fromIntegral ci),d_tt)] drho where
d_tt = 1/(fromIntegral d)
d_it = 1/sqrt(1-1/(fromIntegral d)^2)
d = dist i j (YT t)
drho = dim $ (Part $ map length t)
tauT = adjImage i (YT t)
tauIndex = fromIntegral $ fromJust $ elemIndex tauT (standard (Part p))
p = map length t
-- Action by a transposition
adjImage :: Int -> YoungTableau -> YoungTableau
adjImage i (YT t) = actBy perm (YT t) where
perm = fromCycles [[i,(i+1)]] order
order = sum $ map length t
-- Given a partition, return the list of standard tableau of the same shape
standard :: Partition -> [YoungTableau]
standard (Part a) = take (fromIntegral $ dim $ Part a) $ filter isStandard $ map (\i -> actBy (s n !! (i-1)) (standardTableau (Part a))) ([1..order]) where
n = sum a
order = product [1..n]