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