loopy-0.0: Stab.hs
{-# LANGUAGE ScopedTypeVariables #-}
module Stab 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 LoopProp
import Debug.Trace
diagS :: Double -> Foodweb -> Matrix Double
diagS s fw = mapMatrixInd0 f $ cm fw
where
d = findD fw
f i j x|i == j && Just i /= d = s*x --
|otherwise = x
findD :: Foodweb -> Maybe Int
findD fw = findIndex (\x -> deathRate x == 0) $ info fw
getEVals :: Matrix Double -> [Double]
getEVals m = map realPart $ toList $ fst $ eigR $ fromLists m
filterPos :: [Double] -> Int
filterPos evals = length $ filter (>0) evals
isHigher :: Foodweb -> Double -> Bool
isHigher fw smed = if zeroE ==0 && medE /= 0 || zeroE /=0 && medE == 0 then False else True
where
medE = filterPos $ getEVals $ diagS smed fw
zeroE = filterPos $ getEVals $ diagS 0 fw
findF :: (Double -> Bool) -> (Double,Double) -> Double
findF f (lo,hi) | hi-lo < 0.00000001 = med
| f med = findF f (med, hi)
| otherwise = findF f (lo, med)
where
med = (lo + hi)/(fromIntegral 2)
findStab :: Foodweb -> Double
findStab fw = if zeroE == 0 then 0 else findF (isHigher fw) (0,2)
where
zeroE = filterPos $ getEVals $ diagS 0 fw
-- error $ show (v, stable m v, stable m (v+0.001), stable m (v-0.001))
-- findStab fw = findF (isHigher fw) (0,2)-- error $ show (v, stable m v, stable m (v+0.001), stable m (v-0.001))
{-
stable :: Matrix Double -> Double -> Bool
stable commat s = all (<= 0) $ getEVals $ diagS s commat
-}
output :: [(Maybe Double, Double)] -> String
output xs = unlines [show a ++ "\t" ++ show b | (Just a,b) <- xs]--just shows things if they aren't NA
showJust (Just x) = show x
showJust Nothing = "NA"
nothing0 (Just x) = x
nothing0 Nothing = 0
sumAlpha :: Matrix Double -> Double
sumAlpha alpha = sum $ map sum alpha
readAlpha :: FilePath -> IO (Matrix Double)
readAlpha fp = do
input <- readFile fp
let alpha = matrixStringToDouble $ toMatrix input
return(alpha)
readAlphas :: FilePath -> IO [Matrix Double]
readAlphas fp = do
allfiles <- getDirectoryContents fp
let ss = filter (\x -> takeExtension x == ".alpha") allfiles
res<- sequence [readAlpha (fp </> s)| s <- ss]
alphas<-return $ res
return(alphas)
readAlphaSum :: FilePath -> IO [Double]
readAlphaSum fp = do
alphas<-readAlphas fp
let sums = map sumAlpha alphas
return(sums)
readStabs :: FilePath -> IO [Double]
readStabs fp = do
allfiles <- getDirectoryContents fp
let ss = filter (\x -> takeExtension x == ".stab") allfiles
res<- sequence [readStab (fp </> s)| s <- ss]
stabs<-return $ res
return(stabs)
{-
testStabs :: FilePath -> IO [Double]
testStabs fp = do
--res1<-return $readStabs
old<-return $ [0.0002,0.006,0.0005,0.0003,0.277,0.374,0.259,0.134,0.0092,0.0126,0.0107,0.0354,0.317,0.14,0.223,0.205,0.0001,0.0001,0,0.0001,0.359,0.251,0.309,0.29,0.235,0.178,0.124,0.24,0.204,0.42,0.459,0.285] :: [Double]
return(old)
-}
readProps :: FilePath -> Int-> Int-> Int -> IO [Maybe Double] -- if want mlw not mlw3 etc use 0 or 1 as rn lm is min ll wanted, need to take intoaccoutn NAs
readProps fp ll cn lm= do
allfiles <- getDirectoryContents fp
let ss = filter (\x -> takeExtension x == ".log") allfiles
props<- sequence [readProp (fp </> s) cn lm | s <- ss]
--
res<-if ll<=1
then return $ [maximum proplist | proplist<-props]
else return $ [llProp ll lm proplist | proplist<-props]
return(res)
--not working due to integer/int confusion
--find max for each thing, total for num and not mlw loop
summarizeProps :: FilePath -> Int -> IO ()
summarizeProps fw lmin = do
let fp=(dropExtension fw ++".log")
t2<-readProp fp (fromIntegral 2) (fromIntegral 2)
let lm = if length t2< lmin then 2 else lmin
t<-readProp fp (fromIntegral 2) (fromIntegral lm)
props<-sequence [readProp fp i (fromIntegral lm)|i<-[1..8]]
let num = sum $map fromJust t
maxtps = map (maxProp (fromIntegral lm)) props
maxll = concat $ intersperse "\t" $ map show $ map snd maxtps
maxs = concat $ intersperse "\t" $ map show $ map fst maxtps
title = "\n\nTable of Maximums for each loop catagory with the corresponding LL \n \t LL \t Num \t MLW \t MLW+ \t MLW- \t MLWe \t MLWo \t MLWnet \n"
res = "Total Number of Loops = " ++ show num ++ title ++ "LL\t" ++ maxll ++ "\n" ++"maxs\t" ++ maxs ++ "\n"
writeFile (dropExtension fp ++ ".sum") res
--putStr(res)
findMaxLL :: FilePath -> IO ()
findMaxLL fp = do
allfiles <- getDirectoryContents fp
let ss = filter (\x -> takeExtension x == ".sum") allfiles
mlws<-sequence [takeMLW (fp </> s) | s <- ss]
writeFile (dropExtension fp ++ ".mlws") (unlines mlws)
takeMLW :: FilePath -> IO String
takeMLW sumfile = do
t<-readFile sumfile
let res = ((map words (lines t))!!4!!3)-- :: Double
return(res)
--get the proplist using readProp
maxProp :: Integer ->[Maybe Double] -> (Double,Integer)
maxProp lm proplist = maximum $ zip (map nothing0 proplist) [lm..]
readPropsT :: FilePath -> Int-> Int-> Int -> IO [Maybe Double] -- if want mlw not mlw3 etc use 0 or 1 as rn lm is min ll wanted, need to take intoaccoutn NAs
readPropsT fp ll cn lm= do
allfiles <- getDirectoryContents fp
let ss = filter (\x -> takeExtension x == ".log") allfiles
props<- sequence [readProp (fp </> s) cn lm | s <- ss]
--
res<-if ll<=1
then return $ [maximum proplist | proplist<-props]
else return $ [llProp ll lm proplist | proplist<-props]
return(res)
--writeStabLoops
writeStabProps :: FilePath -> Int -> Int -> Int-> IO ()
writeStabProps fp ll cn lm= do
stabs<-readStabs fp
props<-readProps fp ll cn lm
res<-return $ zip props stabs
writeFile (fp ++ "Stabvs" ++ show ll ++ "_" ++ show cn ++ ".txt") $ output res
return()
maybeRead :: Read a => String -> Maybe a
maybeRead = fmap fst . listToMaybe
. reads
readProp :: FilePath -> Int -> Int -> IO [Maybe Double]--need to adjust so returns [] if too big
readProp fp cn lm = do
x <-readLoopPropFile fp
n<- return $length x
prop<-return$ [x!!y!!(cn-1) | y<-[(lm-2)..(n-1)]]--check this is correct regarding the n-1 bit
prop2<-return $map maybeRead prop
return(prop2)
--mapD :: String -> Maybe Double
--mapD x = read x :: Maybe Double
llProp :: Int -> Int-> [Maybe Double] -> Maybe Double
llProp ll lm proplist = if (ll-lm+1)<= length proplist then proplist!!(ll-lm) else Nothing -- not working properly, not returning nothing
readStab :: FilePath -> IO Double -- checked ok
readStab x = do
s<-readFile $x--fp</>x
let y =read s :: Double
return(y)
readLoopPropFile :: FilePath -> IO [[String]]
readLoopPropFile file = do
x <- readFile file
return $ tail $ map words (lines x)
readLoops :: FilePath -> Int -> IO [[Int]]
readLoops fp lm= do
x <-readLoopPropFile fp
n<- return $length x
prop<-return$ [x!!y!!8 | y<-[(lm-2)..(n-1)]]--check this is correct regarding the n-1 bit
--error $ show $ head prop
prop2<-return $map read prop
return(prop2)
{--}
readLoop :: FilePath -> Int -> Int -> IO [Int]
readLoop fp lm ll = do
x <-readLoops fp lm
return(x!!(ll-lm))
{---assume that loopy has already been run
loopBiomassRatio :: Foodweb ->[Int] -> [Int]
loopBiomassRatio fw loop1= [ biomassRatio loop1!!x loop1!!y | x<-[0..(length loop1-1)],y<-(if x==(length loop1-1) then 0 else x+1) ]
-}
biomassRatio :: Int -> Int -> Double
biomassRatio x y = (fromIntegral x)/(fromIntegral y)
{-
------------------------------------------------------------------------------------------------------------------------------------------
getSpProp :: FilePath -> Int -> Int ->IO String -- rn is the LL and cn is the prop col number
getSpProp file rn cn = do
x <-readLoopPropFile file
return $ x!!(rn-2)!!(cn-1)
getStabVsProp :: FilePath -> Int -> Int -> IO ()
getStabVsProp fp rn cn = do -- ll then prop
getAllStab fp
getAllProp fp rn cn
s<-readFile (fp ++ "Stabilities.txt")
s2 <- return $ read s :: IO [(String,Double)]
p <- readFile (fp ++ "Props.txt") -- if equal nothing need to remove the s val
p2 <- return $ read p :: IO [String] --need to read as double if number
stabs<- return $ map snd s2
res<- return $ zip p2 stabs
writeFile (fp ++ "Stabvs" ++ show rn++ "_" ++ show cn ++ ".txt") $ show res
return ()
if head e1 == '[' then return $ Just $ Left e1
else if e1 == "NA" then return Nothing
else return $ Just $ Right (read e1 :: Double)
getAllStab :: FilePath -> IO ()
getAllStab fp= do
--read list of files and on each one make list of name and stab - tuples
allfiles <- getDirectoryContents fp
let ss = filter (\x -> takeExtension x == ".stab") allfiles
res<- sequence [getStabFromFile (fp </> s)| s <- ss]
writeFile (fp ++ "Stabilities.txt") $ show res
return()
getAllProp:: FilePath-> Int -> Int -> IO ()
getAllProp fp rn cn =do
allfiles <- getDirectoryContents fp
let ss = filter (\x -> takeExtension x == ".log") allfiles
res<- sequence [getSpProp (fp </> s) rn cn | s <- ss] --fp <\> creates a dir
writeFile (fp ++ "Props.txt") $ show res
return()
-}
--data Either a b = Left a | Right b
--data Maybe a = Nothing | Just a
{---get a certain result from loop matrix, eg mlw3
getSpProp :: FilePath ->String -> Int -> IO ()
getSpProp fp pr n = do
--read list of files and on each one make list of name and stab - tuples
allfiles <- getDirectoryContents fp
let loopInfo = filter (\x -> takeExtension x == ".log") allfiles
res<- sequence $ map getProp loopInfo pr
writeFile (fp ++ "Properties.txt") $ show res
return()
-}
--read file
--match string to column number
--get row from row number (-1) and match to column number
{-
read file, and choose a column
with column, choose row number or max/min
y needs to read, then convert to matrix. match top column to pr, then n columns to loop length or max, min, with or without 2 loops
-}
--plot s against different props loop weight
--add on further loops prop - either direction of loop, omnivorous loops, divide by death rate or not
--
--
--
--
{-
NEED TO REDO THE BELOW STUFF, SO DON'T OUTPUT STAB AND PROP SUMMARY FILES, JUST THE OVERALL ONES
readStabDir :: FilePath -> IO [StabInfo]
readStabDir =
process path = do
file <- getdirectorycontents path
res <- sequence $ map readStabLogFile file
....
writeFile "summary.txt" (output res2)
processMe :: ([StabInfo] -> String) -> FilePath -> IO ()
processMLEnet stabs = ....
-}
--need to have extra function for looking at the actual loops