{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-} --runhaskell Main.hs *.fw module Main(main) where import System.Environment --import Matrix import Graph import LoopProp import FeedingRates import Types import Stab import DotFile import Data.Char import System.FilePath import System.Directory import Avalon import Data.List import Mlw import Graphics.Plot import Data.Maybe import System.Console.CmdArgs --import LinearRegression --import Modern --import Numeric.LinearAlgebra data LoopyOpt = LoopyOpt {filename :: String ,loopOutput :: Bool ,omni :: Bool } deriving (Data,Typeable) loopyOpt = cmdArgsMode $ LoopyOpt {filename = "check.fw" &= args &= typ "FILE/DIR" ,loopOutput = False &= help "Output All loops found. Slows program" ,omni = False &= help "Loops shown under MLW are Omnivorous Loops"} &= summary "\nEmily's Loop Finder" --this is the command line directory main:: IO () main = do o@LoopyOpt{..} <-cmdArgsRun loopyOpt --[fp] <- getArgs --x<-return fp if (length (takeExtension filename)) == 0 then mainPath o else mainFile o -- --mainPath fp# -- if input alpha, don't stability --if fw then output alpha mainPath :: LoopyOpt-> IO () mainPath o@LoopyOpt{filename=fp,..} = do allfiles <- getDirectoryContents fp let ss = filter (\x -> takeExtension x == ".fw" ) allfiles tt1 = filter (\xx -> takeExtension xx == ".alpha" ) allfiles tt = myMerge tt1 ss res<- sequence [mainFile o{filename=(fp s)} | s <- tt] --fp <\> creates a dir --writeBrs fp 3 --writeBiomassRatios fp --putStr (show tt) return() mainFile :: LoopyOpt -> IO () mainFile LoopyOpt{filename=fp,..} = do l<- returnComponents fp if length l==1 then getLoopyInfoA loopOutput fp else do outputAlpha fp if omni then do getLoopyInfoOmni loopOutput fp putStr "Only finding Omnivorous Loops\n" else getLoopyInfo loopOutput fp getStabInfo fp --putStr ("stab and loopy done\n") drawFoodweb fp --putStr("next\n") --fig2 fp writeEV fp writeEV0 fp summarizeProps fp 3 return() mainFileOmni :: LoopyOpt -> IO () mainFileOmni LoopyOpt{filename=fp,..} = do l<- returnComponents fp if length l==1 then getLoopyInfoA loopOutput fp else do outputAlpha fp getLoopyInfoOmni loopOutput fp getStabInfo fp --putStr ("stab and loopy done") drawFoodweb fp fig2 fp summarizeProps fp 3 return() getLoopyInfo :: Bool ->FilePath -> IO () getLoopyInfo loopOutput x = do putStr ("Loopy running on: " ++ x ++ "\n") z <- fileToFoodweb x let y = checkFoodweb z let t = getCommat y let n = length t m = matrixFromList t g = graphFromMatrix n m ps = summarize $ map (classify m) (loops g) --[propSum] let titles = ["LL", "Num", "MLW","MLW+","MLW-", "MLWe","MLWo","MLWnet","MLW Loop"] -- , tbl = titles : map propSumRow ps res = outputMatrix tbl ps2 = ("Loop\tLL\tLW\tSign\tCount\tNet\n") ++ (concat $ map propSumOutput $ [(classify m) ((loops g)!!i) | i <-[0..(length (loops g)-1)]]) -- writeFile (dropExtension x ++ ".html") $ prefix ++ img (outputChart ps) ++ "
" ++ htmlMatrix tbl ++ suffix if loopOutput then writeFile (dropExtension x ++ ".loops") ps2 else putStr "Loops not outputted\n" writeFile (dropExtension x ++ ".log") res putStr (res)--from res --this currently only shows the omni loops in the log file, and that is the only difference getLoopyInfoOmni :: Bool -> FilePath -> IO () getLoopyInfoOmni loopOutput x = do putStr ("Loopy running on: " ++ x ++ "\n") z <- fileToFoodweb x let y = checkFoodweb z let t = getCommat y let n = length t m = matrixFromList t g = graphFromMatrix n m ps = summarize $ map (classify m) (loops g) --[propSum] let titles = ["LL", "Num", "MLW","MLW+","MLW-", "MLWe","MLWo","MLWnet","MLWo Loop"] -- , tbl = titles : map propSumRowOmni ps res = outputMatrix tbl ps2 = ("Loop\tLL\tLW\tSign\tCount\tNet\n") ++ (concat $ map propSumOutput $ [(classify m) ((loops g)!!i) | i <-[0..(length (loops g)-1)]]) -- writeFile (dropExtension x ++ ".html") $ prefix ++ img (outputChart ps) ++ "
" ++ htmlMatrix tbl ++ suffix if loopOutput then writeFile (dropExtension x ++ ".loops") ps2 else putStr "Loops not outputted\n" writeFile (dropExtension x ++ ".log") res putStr (res)--from res getLoopyInfoA :: Bool -> FilePath -> IO () getLoopyInfoA loopOutput y = do putStr ("Loopy running on: " ++ y ++ "\n") input <-readAlpha y let t = input n = length t m = matrixFromList t g = graphFromMatrix n m ps = summarize $ map (classify m) (loops g) --[propSum] titles = ["LL", "Num", "MLW","MLW+","MLW-", "MLWe","MLWo","MLWnet","MLW Loop"] -- , tbl = titles : map propSumRow ps res = outputMatrix tbl ps2 = ("Loop\tLL\tLW\tSign\tCount\tNet\n") ++ (concat $ map propSumOutput $ [(classify m) ((loops g)!!i) | i <-[0..(length (loops g)-1)]]) if loopOutput then writeFile (dropExtension y ++ ".loops") ps2 else putStr "Loops not outputted\n" writeFile (dropExtension y ++ ".log") res putStr (res) {- -} {- getLoopyInfoDetDir :: FilePath -> IO () getLoopyInfoDetDir fp = do allfiles <- getDirectoryContents fp let allLoops = filter (\x -> takeExtension x == ".loops" ) allfiles sequence [getLoopyInfoDet (fp s3) | s3 <- allLoops] --fp <\> creates a dir return() --loopsG = (detLoops (fromJust detRow) (loops g) getLoopyInfoDet :: FilePath -> IO () getLoopyInfoDet ll = do loops <- readLoopList ll fw<-fileToFoodweb ((dropExtension fp) ++ ".fw") let ds = map deathRate $ info fw let detRow = findIndex (==0) ds -} writeEV :: FilePath -> IO [Double] writeEV fp = do fw<-fileToFoodweb fp let cm = getCommat fw res = getEVals cm writeFile (dropExtension fp ++ ".evs") (unlines $ map show res) return (res) writeEV0 :: FilePath -> IO [Double] writeEV0 fp = do fw<-fileToFoodweb2 fp let res = getEVals $ diagS 0 fw putStr(show res ++ "\n") writeFile (dropExtension fp ++ ".evs0") (unlines $ map show res) return (res) writeEV0a :: FilePath -> IO [Double] writeEV0a fp = do fw<-fileToFoodweb fp let d = findD fw cm = getCommat fw cm0 = zerodiagd cm (fromJust d) res = getEVals cm0 writeFile (dropExtension fp ++ ".evs0") (unlines $ map show res) return (res) zerodiagd :: Matrix Double -> Int -> Matrix Double zerodiagd m d= mapMatrixInd f m where f i j x | i==j&&i/=(d) = 0 | otherwise = x zerodiag :: Matrix Double -> Matrix Double zerodiag m= mapMatrixInd f m where f i j x | i==j = 0 | otherwise = x getLoopyInfoChoice :: FilePath -> Int-> IO () getLoopyInfoChoice x ll = do putStr ("Loopy running on: " ++ x ++ "\n") z <- fileToFoodweb x let y = checkFoodweb z let t = getCommat y let n = length t m = matrixFromList t g = graphFromMatrix n m ps = summarize $ map (classify m) (loops g) --[propSum] let titles = ["LL", "Num", "MLW","MLW+","MLW-", "MLWe","MLWo","MLWnet","MLWo Loop"] -- , tbl = titles : map (propSumRowChoice ll ) ps res = outputMatrix tbl ps2 = ("Loop\tLL\tLW\tSign\tCount\tNet\n") ++ (concat $ map propSumOutput $ [(classify m) ((loops g)!!i) | i <-[0..(length (loops g)-1)]]) -- writeFile (dropExtension x ++ ".html") $ prefix ++ img (outputChart ps) ++ "
" ++ htmlMatrix tbl ++ suffix --writeFile (dropExtension x ++ ".loops") ps2 writeFile (dropExtension x ++ ".log") res putStr (res)--from res getStabInfo :: FilePath -> IO () getStabInfo x = do putStr ("Stability for " ++ dropExtension x++": " ) y <- fileToFoodweb x let z = checkFoodweb y z <- return $ z{cm=getCommat z} -- FIXME: Reorder to remove this let s = findStab z writeFile (dropExtension x ++ ".stab") (show s) let evals = getEVals $ diagS s z putStr (show evals ++ "\n") putStr (show s ++ "\n") img x = "
" myMerge ::[FilePath] -> [FilePath] -> [FilePath] myMerge [] ys = ys myMerge (x:xs) ys = if (elem (dropExtension x) (map dropExtension ys)) then myMerge xs ys else [x]++ myMerge xs ys removeDet :: Foodweb -> Foodweb removeDet f = deleteSps f (getDetRow f) writeFwND :: FilePath -> IO () writeFwND fp = do fw<-fileToFoodweb fp let f = removeDet fw writeFoodweb (dropExtension fp ++ "_ND.fw") f --dropExtension fp ++ "_ND" return() --working, but not putting int hte new directory writeFwNDDir :: FilePath -> IO () writeFwNDDir fp = do allfiles <- getDirectoryContents fp createDirectoryIfMissing True $ dropExtension fp ++ "_ND" let fs = filter (\x -> takeExtension x == ".fw") allfiles putStr ("fs done\n") sequence [writeFwND (fp s )| s<-fs] return() outputGraphsDir :: FilePath -> IO () outputGraphsDir fp = do allfiles <- getDirectoryContents fp let allLoops = filter (\x -> takeExtension x == ".loops" ) allfiles sequence [writeTableLW (fp s1) | s1<- allLoops] --fp <\> creates a dir sequence [writeTableLWo (fp s2) | s2 <- allLoops] --fp <\> creates a dir sequence [writeTableLWd (fp s3) | s3 <- allLoops] --fp <\> creates a dir --sequence [writeTableLWdNotONot (fp s3) | s3 <- allLoops] --fp <\> creates a dir sequence [writeTableLWdNot (fp s3) | s3 <- allLoops] --fp <\> creates a dir sequence [writeSummaryTableTypes (fp s3) | s3 <- allLoops] --fp <\> creates a dir --putStr (show tt) return() changeToFoodweb :: FilePath -> IO () changeToFoodweb fp = do fw<-fileToFoodweb fp writeFoodweb (dropExtension fp ++ ".fw") fw putStr (show fp) return() changeToFoodwebDir :: FilePath -> IO () changeToFoodwebDir fp = do allfiles <- getDirectoryContents fp let ss = filter (\x -> takeExtension x == ".DAT" ) allfiles res<- sequence [changeToFoodweb (fp s) | s <- ss] --fp <\> creates a dir return() foodwebList :: [[Int]] -> Foodweb -> [Foodweb] foodwebList [] fw = [] foodwebList (x:xs) fw =[changeFeeding fw x] ++ foodwebList xs fw stabList :: [Foodweb] -> [Double] stabList [] = [] stabList (f:fs) =[findStab f] ++ stabList fs breakList :: Int -> [a] -> [[a]] breakList n as =if length as <= n then [as] else fst y : breakList n ((snd y)) where y = splitAt n as {- everything :: IO () everything = do main --on all the files getStabVsProp fp rn cn = do -} --run main of a directory of files {--} --create a foodweb --vary biomasses if appropriate --then run the below {- writeSpeciesChangeTable :: FilePath -> Int -> IO [Double] writeSpeciesChangeTable fp n = do createSFtoOsmoRange fp n main (dropExtension fp ++ "SFtoOsmo") stabs<-readStabs (dropExtension fp ++ "SFtoOsmo") ss<- return $breakList (n+1) stabs writeFile (dropExtension fp ++ "SFtoOsmo.txt") $ unlines $ map (intercalate "\t") $map2 show ss return(stabs) -} cf :: LoopyOpt -> IO () cf o@LoopyOpt{filename=fp,..} = do fw2<-fileToFoodweb fp let g2 = checkFoodweb fw2 let n = (length $ info g2)-5 let g22=changeFeeding g2 (replicate n 2) let g33=changeFeeding g2 (replicate n 3) writeFoodweb (dropExtension fp ++ "33a.fw") g33 writeFoodweb (dropExtension fp ++ "22a.fw") g22 getLoopyInfo loopOutput (dropExtension fp ++ "33a.fw") getStabInfo (dropExtension fp ++ "33a.fw") getLoopyInfo loopOutput (dropExtension fp ++ "22a.fw") getStabInfo (dropExtension fp ++ "22a.fw") funct23 :: [[Int]] -> [[Int]] funct23 [] = [] funct23 x = [2:(head x), 3:(head x)]++ funct23 (tail x) generate23 n = iterate funct23 [[]]!!n funct13 :: [[Int]] -> [[Int]] funct13 [] = [] funct13 x = [1:(head x), 3:(head x)]++ funct13 (tail x) generate13 n = iterate funct13 [[]]!!n {-something going wrong here -} allFSDir :: FilePath -> IO () allFSDir fp =do allfiles <- getDirectoryContents fp let tt = filter (\x -> takeExtension x == ".fw" ) allfiles res<- sequence [allFS s | s <- tt] --fp <\> creates a dir return() allFS :: FilePath -> IO ([([Int],Double)]) allFS fp = do fw2<-fileToFoodweb fp let fw = checkFoodweb fw2 let n = (length $ info fw)-5 fws = foodwebList (generate23 n) fw fwsA = map putCM fws res<- sequence [writeFoodweb (dropExtension fp ++ show s ++ ".fw") (fwsA!!s) | s <- [0..(length (generate23 n)-1)]] let stabs = stabList fwsA res = zip (generate23 n) stabs writeFile (dropExtension fp ++ ".stabLog") (tableTuple res) return(res) ---chemo fs stuff {- writeChemoRangeTable :: FilePath -> Int -> IO [Double] writeChemoRangeTable fp n= do createChemoRange fp n mainPath (dropExtension fp ++ "ChemoRange") sumAlphas<-readAlphaSum (dropExtension fp ++ "ChemoRange") ss<- return $breakList (n+1) sumAlphas writeFile (dropExtension fp ++ "ChemoRange.txt") $ unlines $ map (intercalate "\t") $map2 show ss return(sumAlphas) -} allFSChemo :: FilePath -> IO ([([Int],Double)]) allFSChemo fp = do fw2<-fileToFoodweb fp let fw = checkFoodweb fw2 let n = (length $ info fw)-5 fws = foodwebList (generate13 n) fw fwsA = map putCM fws res<- sequence [writeFoodweb (dropExtension fp ++ show s ++ ".fw") (fwsA!!s) | s <- [0..(length (generate23 n)-1)]] let cms = map cm fwsA let aphs = map sumAlpha cms -- change to alphas res = zip (generate13 n) aphs writeFile (dropExtension fp ++ ".sumAlphaLog") (tableTuple res) return(res) --moved putCM tableTuple to FeedingRates.hs 20/08/2010 --------modern fish stuff changeNoFish :: Foodweb -> Double -> Foodweb changeNoFish (Foodweb names info wij cm) osProp= Foodweb names (info) (changeWij wij) cm where changeWij wij = mapMatrixInd f wij where f i j x|i ==6 && j ==3 =(1-osProp)*100 --sepenson |i ==5 && j ==3 =osProp*100 --eating off detritus |otherwise = x createNFRange :: FilePath -> Int-> IO () createNFRange fp n = do fw <- fileToFoodweb fp createDirectoryIfMissing True (dropExtension fp ++ "PhyRange") sequence_ [writeFoodweb file $ changeNoFish fw x | x <- [0,1/(fromIntegral n)..1], let file = dropExtension fp ++ "PhyRange" dropExtension fp ++ "_" ++ show3dp x ++ ".fw"] ------------osmo vs sf writeOsmoRangeTable :: LoopyOpt -> Int -> IO [Double] writeOsmoRangeTable o@LoopyOpt{filename=fp,..} n= do createOsmoRange fp n mainPath o{filename=(dropExtension fp ++ "OsmoRange")} stabs<-readStabs (dropExtension fp ++ "OsmoRange")--sequence [readStabs (fp ++ "OsmoRange")| file<-files] ss<- return $breakList (n+1) stabs writeFile (dropExtension fp ++ "OsmoRange.txt") $ unlines $ map (intercalate "\t") $map2 show ss return(stabs) writeOsmoRange2Table :: LoopyOpt -> Int -> IO [Double] writeOsmoRange2Table o@LoopyOpt{filename=fp,..} n= do createOsmoRange2 fp n mainPath o{filename=(dropExtension fp ++ "OsmoRange2")} stabs<-readStabs (dropExtension fp ++ "OsmoRange2")--sequence [readStabs (fp ++ "OsmoRange")| file<-files] ss<- return $breakList (n+1) stabs writeFile (dropExtension fp ++ "OsmoRange2.txt") $ unlines $ map (intercalate "\t") $map2 show ss return(stabs) writeChemoRangeTable :: LoopyOpt -> Int -> IO [Double] writeChemoRangeTable o@LoopyOpt{filename=fp,..} n= do createChemoRange fp n mainPath o{filename=(dropExtension fp ++ "ChemoRange")} sumAlphas<-readAlphaSum (dropExtension fp ++ "ChemoRange") ss<- return $breakList (n+1) sumAlphas writeFile (dropExtension fp ++ "ChemoRange.txt") $ unlines $ map (intercalate "\t") $map2 show ss return(sumAlphas) --readAlphaSum is equivlanf stabs writeFrondRangeTable :: LoopyOpt -> Int -> Int -> IO [Double] writeFrondRangeTable o@LoopyOpt{filename=fp,..} n1 n2 = do createFrondRange fp n1 n2 mainPath o{filename=(dropExtension fp ++ "FrondRange")} stabs<-readStabs (dropExtension fp ++ "FrondRange")--sequence [readStabs (fp ++ "FrondRange")| file<-files] ss<- return $breakList (n1+1) stabs writeFile (dropExtension fp ++ "FrondRange.txt") $ unlines $ map (intercalate "\t") $map2 show ss return(stabs) --------------extra stuff prefix = unlines ["" ,"" ,"" ,"" ,"" ] suffix = "" htmlMatrix :: Matrix String -> String htmlMatrix = wrap "table" . concatMap (wrap "tr" . concatMap (wrap "td")) where wrap tag str = "<" ++ tag ++ ">" ++ str ++ "" -- loops g = the list of all loops for graph g