loopy-0.0: LoopProp.hs

--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) 
{-

-}