{-# 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
[""
,"