From 73f5c3f45e5971f9b5c78d0a0fcac23b4561b869 Mon Sep 17 00:00:00 2001
From: Jeshiba <baconp@gmail.com>
Date: Mon, 17 Jul 2017 10:07:04 -0400
Subject: changed Q; added weyl chamber test.

- Changed Q from Math.Algebra.Field.Base.Q to Rational for better
prelude support despite ugly show functions, see PitmanTransform.hs
line 82
- Added test prop_Pitman_WeylChamber verifying the result of the
Pitman's transform is in the WeylChamber
- Fixed a bug in pitman: added 0 initial condition to the input
paths and removed the first row in the output corresponding to the
initial condition. Otherwise prop_Pitman_Weylchamber won't verify.
---
 .gitignore                            |  1 +
 Math/Combinatorics/PitmanTransform.hs | 48 +++++++++++++++++++++++++++++++----
 Math/Combinatorics/RootSystem.hs      |  5 ++--
 3 files changed, 47 insertions(+), 7 deletions(-)
 create mode 100644 .gitignore

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..1377554
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+*.swp
diff --git a/Math/Combinatorics/PitmanTransform.hs b/Math/Combinatorics/PitmanTransform.hs
index 0379bce..fa979d7 100644
--- a/Math/Combinatorics/PitmanTransform.hs
+++ b/Math/Combinatorics/PitmanTransform.hs
@@ -12,15 +12,20 @@
 import RootSystem hiding (s)
 import YoungTableaux
 import RobinsonSchensted
-import Math.Algebra.Field.Base (Q)-- for Q
+--import Math.Algebra.Field.Base (Q)-- for Q
 import Math.Algebra.LinearAlgebra
 import Prelude hiding ( (*>), Word )
 import Test.QuickCheck
 import qualified Data.List as L
+import Data.Ratio
 
 --pitman :: (Fractional a, Ord a) => Type -> Int -> [a] -> [a]
 pitman :: Type -> Int -> [[Q]] -> [[Q]]
-pitman t n xs = foldr s xs (longestElement $ simpleSystem t n)
+pitman t n xs = tail $ foldr s (prependWithZero xs) (longestElement $ simpleSystem t n)
+
+prependWithZero :: [[Q]] -> [[Q]]
+prependWithZero [] = []
+prependWithZero xs = (replicate (length $ head xs) 0) : xs
 
 s :: [Q] -> [[Q]] -> [[Q]]
 --s :: (Fractional a, Ord a) => [a] -> [a] -> [a]
@@ -35,7 +40,8 @@ cumSum = scanl1 (+)
 
 word2Path :: Word Int -> [[Q]]
 word2Path (W []) = []
-word2Path (W xs) = L.transpose $ cumSum <$> [0:(indicator (==k) xs) | k <- [1..maximum xs]]
+--word2Path (W xs) = L.transpose $ cumSum <$> [0:(indicator (==k) xs) | k <- [1..maximum xs]]
+word2Path (W xs) = L.transpose $ cumSum <$> [indicator (==k) xs | k <- [1..maximum xs]]
 
 indicator :: (a -> Bool) -> [a] -> [Q]
 indicator f xs = (\x -> if f x then 1 else 0) <$> xs
@@ -68,9 +74,41 @@ prop_Pitman_RobinsonSchensted_sanitise :: [Int] -> Word Int
 prop_Pitman_RobinsonSchensted_sanitise = W . (fmap (\t -> abs t + 1))
 
 
+smallRational :: Gen Q
+smallRational = do
+    x <- smallInt
+    y <- smallInt
+    return $ (toInteger x) % (toInteger (abs y + 1)) -- this line does not work if 
+    --return $ (toInteger x) / (toInteger (abs y + 1)) -- this line does not work for Q = Math.Algebra.Field.Base.Q - Couldn't match type ‘Integer’ with ‘Q’
+
+
+--smallRational :: Gen Q
+--smallRational = getSmall <$> (arbitrary :: Gen (Small Q))
+
+--mediumInt :: Gen Int
+--mediumInt = do
+    --x <- smallInt
+    --y <- smallInt
+    --return $ x * y
+
+
+smallInt :: Gen Int
+smallInt = getSmall <$> (arbitrary :: Gen (Small Int))
+
+arbRational :: Gen Q
+arbRational = arbitrary
+
 randomQMatrix :: Int -> Gen [[Q]]
-randomQMatrix n = vectorOf 20 (vector n)
+randomQMatrix n = vectorOf 20 $ vectorOf n smallRational
 
 prop_Pitman_WeylChamber :: Int -> Property
 prop_Pitman_WeylChamber m = let (t, n) = int2TypeInt m in
-    forAll (randomQMatrix $ dimensionOfHostSpace t n) (\xs -> isInWeylChamber $ pitman t n xs)
+    forAll (randomQMatrix $ dimensionOfHostSpace t n) (\xs -> isInWeylChamber (simpleSystem t n) (last $ pitman t n xs))
+
+prop_PitmanA_WeylChamber :: Int -> Property
+prop_PitmanA_WeylChamber n = let m = (n `mod` 2) + 1 in
+    forAll (randomQMatrix $ m + 1) (\xs -> isInWeylChamber (simpleSystem A m) (last $ pitman A m xs))
+
+--prop_PitmanA_WeylChamber :: Property
+--prop_PitmanA_WeylChamber = let m = (1 `mod` 2) + 1 in
+    --forAll (randomQMatrix $ m + 1) (\xs -> isInWeylChamber (simpleSystem A m) (last $ pitman A m xs))
diff --git a/Math/Combinatorics/RootSystem.hs b/Math/Combinatorics/RootSystem.hs
index f92b642..a1674b7 100644
--- a/Math/Combinatorics/RootSystem.hs
+++ b/Math/Combinatorics/RootSystem.hs
@@ -13,12 +13,13 @@ import Data.Maybe
 import qualified Data.Set as S
 
 import Math.Algebra.LinearAlgebra
-import Math.Algebra.Group.PermutationGroup hiding (elts, order, closure)
+--import Math.Algebra.Group.PermutationGroup hiding (elts, order, closure)
 --import Math.Algebra.Group.SchreierSims as SS
 --import Math.Algebra.Group.StringRewriting as SG
 
-import Math.Algebra.Field.Base (Q)-- for Q
+--import Math.Algebra.Field.Base (Q)-- for Q
 
+type Q = Rational
 data Type = A | B | C | D | E | F | G deriving Show
 type SimpleSystem = [[Q]]
 
-- 
cgit v1.2.3