loopy-0.0: Mlw.hs

module Mlw where


import System.Environment
import System.Random
import Control.Monad
import System.Directory
import System.Cmd
import Data.Char
import Data.Maybe
import Data.List
import Numeric
import System.FilePath
import Numeric.LinearAlgebra.LAPACK
import Data.Packed.Matrix hiding (Matrix)
import Data.Packed.Vector
import Data.Complex
import Types
import FeedingRates
import Stab
import Graph


--------------------------------------------------------------------------------

readLoopList :: FilePath -> IO [[String]]
readLoopList fp = do
	x<-readFile fp
	let z = map words (lines x)
	return(tail(z))
	

-- output table of LW vs LL for all points

writeTableLW :: FilePath -> IO ()
writeTableLW fp = do
	loops<-readLoopList fp
	let x = map createCoord loops
	writeFile (dropExtension fp ++ ".LWvsLL") (unlines x)
	return()
	
	
createCoord :: [String] -> String
createCoord l = concat $ intersperse "\t" [l!!1,l!!2,l!!3]


-- output table of LWo vs LL for all points

writeTableLWo :: FilePath -> IO ()
writeTableLWo fp = do
	loops<-readLoopList fp
	let loopsO = filter (/=[]) (map filterOmni loops)
	let x = map createCoordo loopsO
	writeFile (dropExtension fp ++ ".LWovsLL") (unlines x)
	return()
	
	
filterOmni :: [String] -> [String]
filterOmni [] = []
filterOmni l = if ((readAsInt (l!!4)) == 2-(readAsInt (l!!1))) then l else []
	
	
filterOmniNot :: [String] -> [String]
filterOmniNot [] = []
filterOmniNot l = if ((readAsInt (l!!4)) == 2-(readAsInt (l!!1))) then [] else l

	
readAsInt :: String -> Int
readAsInt i = read i :: Int

createCoordo :: [String] -> String
createCoordo l = concat $ intersperse "\t" [l!!1,l!!2,l!!3,l!!4]
				{- read first column as-}
-- read in loop row with props and det row number
--convert first to list
--if list contains
--if elem detRow loop then output else Nothing


writeSummaryTableDet :: FilePath -> IO ()
writeSummaryTableDet fp = do
	let lw =   ((dropExtension fp) ++ ".LWvsLL")
	    lwd =  ((dropExtension fp) ++ ".LWdvsLL")
	    lwnd =  ((dropExtension fp) ++ ".LWdNotvsLL")
	a<-findMLW3 lw
	b<-findMLWpos lw
	c<-findMLWneg lw  
	d<-findMLW3o lw
	a2<-findMLW3 lwd
	b2<-findMLWpos lwd
	c2<-findMLWneg lwd  
	d2<-findMLW3o lwd
	a3<-findMLW3 lwnd
	b3<-findMLWpos lwnd
	c3<-findMLWneg lwnd 
	d3<-findMLW3o lwnd
	
	let alll = show a ++ "\t" ++  show b ++ "\t" ++  show c ++ "\t" ++  show d ++ "\n" --("\tLW\tLWo\tLWd\tLWnd\nMLW\t") ++ 
	let det = show a2 ++ "\t" ++  show b2 ++ "\t" ++  show c2 ++ "\t" ++  show d2 ++ "\n" --("MLW3\t") ++ 
	let tro = show a3 ++ "\t" ++  show b3 ++ "\t" ++  show c3 ++ "\t" ++  show d3 ++ "\n" --("MLW3\t") ++ 

	writeFile ((dropExtension fp) ++ ".sumLWsDET")(alll ++ det ++ tro)--
	return()


writeSummaryTableTypes :: FilePath -> IO ()
writeSummaryTableTypes fp = do
	let lw =   ((dropExtension fp) ++ ".LWvsLL")
	    lwo =  ((dropExtension fp) ++ ".LWovsLL")
	    lwd =  ((dropExtension fp) ++ ".LWdvsLL")
	    lwnd =  ((dropExtension fp) ++ ".LWdNotvsLL")
	a<- findMLWn2 lw
	b<-findMLWn2 lwo
	c<-findMLWn2 lwd
	d<-findMLWn2 lwnd
	a2<- findMLW3 lw
	b2<-findMLW3 lwo
	c2<-findMLW3 lwd
	d2<-findMLW3 lwnd
	let mlws = show a ++ "\t" ++  show b ++ "\t" ++  show c ++ "\t" ++  show d ++ "\n" --("\tLW\tLWo\tLWd\tLWnd\nMLW\t") ++ 
	let mlw3s = show a2 ++ "\t" ++  show b2 ++ "\t" ++  show c2 ++ "\t" ++  show d2 ++ "\n" --("MLW3\t") ++ 
	writeFile ((dropExtension fp) ++ ".sumLWs")(mlws ++ mlw3s)--
	return()
{--}
--LWd vs LL [(findMLWn2 lw),(findMLWn2 lwo),(findMLWn2 lwd),(findMLWn2 lwnd)]
writeTableLWd :: FilePath -> IO ()
writeTableLWd fp = do
	loops<-readLoopList ((dropExtension fp) ++ ".loops")
	fw<-fileToFoodweb ((dropExtension fp)  ++ ".fw")
	--putStr("fw\n")
	let ds = map deathRate $ info fw
	--putStr(show ds ++ "\n")
	let detRow = findIndex (==0) ds
	--putStr(show detRow ++ "\n")
	
	let loopsD = filter (/= []) $ map (filterDetritus (fromJust detRow)) loops
	    loopsDV = filter (/=[]) $ map (filterDetrivoreNotStr fw) loopsD
	putStr(show (length (loopsDV)) ++ " loopsDV\n"++ show (length (loops)) ++ " loops\n" ++ show (length (loopsD)) ++ " loopsD\n")
	let x = map createCoord loopsDV
	--putStr(show x++"\n")
	writeFile ( (dropExtension fp)  ++ ".LWdvsLL") (unlines x)
	return()
filterDetrivoreNot :: Foodweb -> Loop -> Loop
filterDetrivoreNot fw l = if (groupElem de es) then []  else l -- if (length de) >=1 then () else l
			where
				e = getEdges fw
				de = getDetrEdges n e
				n = fromJust $ detRow fw
				es = loopToEdges l 
				

filterDetrivoreNotStr :: Foodweb ->  [String] -> [String]
filterDetrivoreNotStr fw  []= []
filterDetrivoreNotStr fw l =  if (groupElem de es) then [] else l -- [f (head (head (convertToList ll!!0))) detRow] ++ [filterDetritus f (tail ll) detRow]
				where 
					de = getDetrEdges n (getEdges fw)
					n = fromJust $ detRow fw
					es = loopToEdges $ (convertToLoop (head l))
--not working properly, i think it is still considering reverse end edges
writeTableLWdNot :: FilePath -> IO ()
writeTableLWdNot fp = do
	loops<-readLoopList ((dropExtension fp) ++ ".loops")
	fw<-fileToFoodweb ((dropExtension fp)  ++ ".fw")
	--putStr("fw\n")
	let ds = map deathRate $ info fw
	--putStr(show ds ++ "\n")
	let detRow = findIndex (==0) ds
	--putStr(show detRow ++ "\n")
	
	let loopsD = filter (/= []) $ map (filterDetritusNot (fromJust detRow)) loops
	    loopsDV =  filter (/=[]) $ map (filterDetrivoreStr fw) loops
	    loopsAll = loopsD -- ++ loopsDV
	--putStr(show loopsD ++ "loopsD\n")
	let x = map createCoord loopsAll
	--putStr(show x++"\n")
	writeFile ( (dropExtension fp)  ++ ".LWdNotvsLL") (unlines x)
	return()


filterDetrivore :: Foodweb -> Loop -> Loop
filterDetrivore fw l = if (length de) >=1 then (if (groupElem de es) then l  else []) else []
			where
				e = getEdges fw
				de = getDetrEdges n e
				n = fromJust $ detRow fw
				es = loopToEdges l 
				
filterDetrivoreStr :: Foodweb ->  [String] -> [String]
filterDetrivoreStr fw  []= []
filterDetrivoreStr fw l =  if (groupElem de es) then l else [] -- [f (head (head (convertToList ll!!0))) detRow] ++ [filterDetritus f (tail ll) detRow]
				where 
					de = getDetrEdges n (getEdges fw)
					n = fromJust $ detRow fw
					es = loopToEdges $ (convertToLoop (head l))

filterDV :: Foodweb -> [String] -> [String]
filterDV  fw  []= []
filterDV fw l = undefined

	
filterDetritus :: Int ->  [String] -> [String]
filterDetrius detRow  []= []
filterDetritus detRow l =  if (elem detRow (convertToList (head l))) then l else [] -- [f (head (head (convertToList ll!!0))) detRow] ++ [filterDetritus f (tail ll) detRow]

getEdges :: Foodweb -> Graph
getEdges fw =  edges
			where
				edges = graphFromMatrix n (wij fw)
				n = length (wij fw) --fromJust $ detRow fw
	 			
getDetrEdges :: Int ->Graph-> Graph
getDetrEdges a [] = []
getDetrEdges n e = if ((fst (head e)) == n) then [head e] ++ (getDetrEdges n (tail e))  else (getDetrEdges n (tail e))

getDetrEdgesFw :: Foodweb -> Graph
getDetrEdgesFw fw =getDetrEdges (fromJust (detRow fw)) (getEdges fw)


detRow :: Foodweb -> Maybe Int
detRow fw = findIndex (==0)$  map deathRate $ info fw

loopToEdges2 :: Loop -> Graph
loopToEdges2 [] = []
loopToEdges2 l = if ((length l) > 1) then [(head l ,head (tail l))] ++ loopToEdges2 ((tail l)) else []

loopToEdges :: Loop -> Graph
loopToEdges l = loopToEdges2 l ++  [(last l, head l)]

justLoops :: [String] -> [String]
justLoops ll =undefined -- ( map head ll )-- :: [Loop]


--if any of l1 are contained in l2 returns l2 else returns empty list
groupElem :: (Eq a) => [a] -> [a] -> Bool
groupElem _ [] = False
groupElem [] l2 = False
groupElem l1 l2 = if elem (head l1) l2 then True else (groupElem (tail l1) l2)

notGroupElem :: (Eq a) => [a] -> [a] -> Bool
notGroupElem [] _ = False
notGroupElem l1 l2 = if notElem (head l1) l2 then True else (notGroupElem (tail l1) l2)

--NOTE the below has not been updated	
writeTableLWdNotONot :: FilePath -> IO ()
writeTableLWdNotONot fp = do
	loops<-readLoopList ((dropExtension fp) ++ ".loops")
	fw<-fileToFoodweb ((dropExtension fp)  ++ ".fw")
	--putStr("fw\n")
	let ds = map deathRate $ info fw
	--putStr(show ds ++ "\n")
	let detRow = findIndex (==0) ds
	--putStr(show detRow ++ "\n")
	
	let loopsD = filter (/= []) $ map (filterNoDetritusNorOmni (fromJust detRow)) loops
	--putStr(show loopsD ++ "loopsD\n")
	let x = map createCoord loopsD
	--putStr(show x++"\n")
	writeFile ( (dropExtension fp)  ++ ".LWdNotOvsLL") (unlines x)
	return()

filterNoDetritusNorOmni :: Int -> [String] -> [String]
filterNoDetritusNorOmni detRow  []= []
filterNoDetritusNorOmni detRow l = filterOmniNot $ filterDetritusNot detRow l

filterDetritusNot :: Int ->  [String] -> [String]
filterDetritusNot detRow  []= []
filterDetritusNot detRow l =  if (notElem detRow (convertToList (head l))) then l else [] -- [f (head (head (convertToList ll!!0))) detRow] ++ [filterDetritus f (tail ll) detRow]



convertToList :: String -> [Int]
convertToList str = read str :: [Int]

convertToLoop :: String -> Loop
convertToLoop str = read str :: Loop
--test $ propEven p == 2 - propLength p

--output table of LWdet vs LL showing det vs non det

--take in table showing LL, LW, sign output 

findMLW :: FilePath -> IO (Double)
findMLW fp  =do
	ls<-readLoopList fp
	let ts = ((transpose ls)!!1) 
	let weights = map read ts:: [Double]
	let res = maximum (weights)
	return (res)

findMLWn2 :: FilePath -> IO (Double)
findMLWn2 fp =  do
	ls <-readLoopList fp -- 
	let lsn2 =  (map filterNot2s ls)
	    res = maximum (lsn2)
	return(res)
findMLW3 :: FilePath -> IO (Double)
findMLW3 fp =  do
	ls <-readLoopList fp -- 
	let lsn2 =  (map filter3s ls)
	    res = maximum (lsn2)
	return(res)
findMLW3o :: FilePath -> IO (Double)
findMLW3o fp = undefined
findMLWpos :: FilePath -> IO (Double)
findMLWpos fp = undefined
findMLWneg :: FilePath -> IO (Double)
findMLWneg fp = undefined


filteros :: [String] -> Double
filteros ls = undefined
filterpos :: [String] -> Double
filterpos ls = undefined
filterneg :: [String] -> Double
filterneg ls = undefined

filterNot2s :: [String] -> Double
filterNot2s ls = if ((ls!!0) /="2") then (read (ls!!1) :: Double) else 0

filter3s :: [String] -> Double
filter3s ls = if ((ls!!0) =="3") then (read (ls!!1) :: Double) else 0