--need to change matrix types -- trace (show (a,b,c)) module LoopProp where import Types import Graph import Data.Function import Control.Arrow import Data.List import Data.Maybe import Graphics.Google.Chart import Data.Map(Map) import qualified Data.Map as Map import Debug.Trace {- Options: divide by d or not showing mlw loop, option to choose any of the other loops to show, generate graph with r^2 value, or just output r^2 val -} -- A loop (propLoop) and properties about that loop data Prop = Prop {propLoop :: !Loop ,propLength :: !Int ,propWeight :: !Double ,propPositive :: !Bool ,propEven :: !Int ,propNet :: !Double } deriving Show -- The properties on a set of loops data PropSum = PropSum {propsLength :: !Int ,propsTotal :: !Int ,propsAll :: !(Maybe Prop) -- need to check that it is just positive and negative, not All including net ,propsPositive :: !(Maybe Prop) ,propsNegative :: !(Maybe Prop) ,propsEven :: !(Maybe Prop) ,propsOmni:: !(Maybe Prop) ,propsNet:: !(Maybe Prop) -- the addition of the forward and back loops } deriving Show ---------------- propSum :: Prop -> PropSum propSum p = PropSum (propLength p) 1 (test True) (test $ propPositive p) (test $ not $ propPositive p) (test $ propEven p == 0) -- changed first bracket from just (test True) $ propEven p /= propLength p (test $ propEven p == 2 - propLength p || propEven p ==propLength p - 2) (test True) where test b = if b then Just p else Nothing propSumOutput :: Prop -> String propSumOutput p = (show (propLoop p))++ "\t"++(show (propLength p)) ++ "\t"++ (show3dp (propWeight p) )++ "\t"++ (if (propPositive p) then "+" else "-" ) ++ "\t"++ (show (propEven p)) ++ "\t"++ (show3dp (propNet p)) ++ "\n" --adds two propSums together, taking the maximum values propSumPlus :: PropSum -> PropSum -> PropSum propSumPlus a b = PropSum (propsLength a) (propsTotal a + propsTotal b) (both propsAll) (both propsPositive) (both propsNegative) (both propsEven) (both propsOmni) (bothr propsNet) where both f = join (f a) (f b) join Nothing x = x join x Nothing = x join (Just a) (Just b) | propWeight a > propWeight b = Just a | otherwise = Just b bothr f = joinr (f a) (f b) joinr Nothing x = x joinr x Nothing = x joinr (Just a) (Just b) | propNet a > propNet b = Just a | otherwise = Just b --check that code written this week for signum is correct -- | Finds the properties for a loop, m is the interaction matrix classify :: Matrix Double -> Loop -> Prop classify m loop = Prop loop n -- the loop and the length of the loop (abs (pas / product ds) ** (1 / fromIntegral n)) -- weight of loop-- / product ds taken out dividing by diag for richard law things.... (pas > 0) -- is the loop positive (sum $ map (round . signum) as) -- the sum of the loop (abs ( (abs (pas / product ds) ** (1 / fromIntegral n)) - (abs (pasr / product ds) ** (1 / fromIntegral n)) ))-- reverse weight of loop-- where pas = product as as = map (\(x,y) -> m !! x !! y) $ links loop ds = [m!!i!!i | i <- loop] n = length loop pasr = product asr asr = map (\(x,y) -> m !! x !! y) $ links $ reverse loop -- sorted by the Int separate :: [Prop] -> [(Int, [Prop])] separate = map (fst . head &&& map snd) . groupBy ((==) `on` fst) . sortBy (compare `on` fst) . map (propLength &&& id) summarize :: [Prop] -> [PropSum] summarize = Map.elems . foldl' f Map.empty where f :: Map Int PropSum -> Prop -> Map Int PropSum f mp x = Map.insertWith' propSumPlus (propLength x) (propSum x) mp propSumRow :: PropSum -> [String] propSumRow (PropSum a b c d e f h i) = [show a, show b, g c, g d, g e, g f, g h, g3 i, g2 c] where g = maybe "NA" (show3dp . propWeight) g2 (Just x) = show $ propLoop x g3 = maybe "NA" (show3dp . propNet) ---propSumRowOmni currently doesn't work 25th aug 10 propSumRowOmni :: PropSum -> [String] propSumRowOmni (PropSum a b c d e f h i) = [show a, show b, g c, g d, g e, g f, g h, g3 i, g2 h] where g = maybe "NA" (show3dp . propWeight) g2 = maybe "NA" (show . propLoop) g3 = maybe "NA" (show3dp . propNet) propSumRowChoice :: Int -> PropSum -> [String] propSumRowChoice i1 (PropSum a b c d e f h i) = [show a, show b, g c, g d, g e, g f, g h, g3 i, g2 l1] where g = maybe "NA" (show3dp . propWeight) g3 = maybe "NA" (show3dp . propNet) g2 = maybe "NA" (show . propLoop) l1 = if i1 == 1 then c else if i1 == 2 then d else if i1 == 3 then e else if i1 == 4 then f else if i1 == 5 then h else i {--} -- [1,2,3] = [(1,2),(2,3),(3,1)] links :: [Int] -> [(Int,Int)] links (x:xs) = f x xs where f y [] = [(y,x)] f y (z:zs) = (y,z) : f z zs outputChart :: [PropSum] -> String outputChart xs = chartURL $ setSize 400 257 $ setTitle "Maximum Loop Weights" $ setData (encodeDataSimple $ map f [propsAll,propsPositive,propsNegative,propsEven]) $ setDataColors ["000000","FF0000","0000FF","00000088"] $ setAxisLabels [map (show . propsLength) xs, ["0",show3dp mx]] $ setAxisTypes [AxisBottom, AxisLeft] $ setLegend ["MLW","MLW+","MLW-","MLWe"] $ newLineChart where mx = maximum $ map propWeight $ catMaybes $ concat [[a,b,c,d,e,f] | PropSum _ _ a b c d e f<- xs] f g = [floor $ (i * 61) / mx | y <- map g xs, let i = maybe 0 propWeight y] --type LoopPropFile = [PropSum] --convert :: [String] -> PropSum --convert [a,b,c,d,e,f]=PropSum (read a) (read b) (read c) (read d) (read e) (read f) {- -}