packages feed

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