loopy-0.0: Main.hs

{-# 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) ++ "<br/>" ++ 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) ++ "<br/>" ++ 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) ++ "<br/>" ++ 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 = "<img src=\"" ++ x ++ "\" /><br/>"


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
    ["<html>"
    ,"<head>"
    ,"<style type='text/css'>"
    ,"table {border: 1px solid black;}"
    ,"body {font-family: sans-serif; font-size: small;}"
    ,"td {padding-right: 10px;}"
    ,"</style>"
    ,"</head>"
    ,"<body>"
    ]
    
suffix = "</body></html>"

htmlMatrix ::  Matrix String -> String
htmlMatrix = wrap "table" . concatMap (wrap "tr" . concatMap (wrap "td"))
    where wrap tag str = "<" ++ tag ++ ">" ++ str ++ "</" ++ tag ++ ">"




    
-- loops g = the list of all loops for graph g