loopy-0.0: DotFile.hs

module DotFile 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 Stab

--------------------------------------------------------------------------------
--generating a dot file from a fw
funct :: [Int] -> Int -> [Int] 
funct [] a = []
funct m rw = if (head m) ==0
		then [0] ++ funct (tail m) rw
		else [rw] ++ funct (tail m) rw

wijSimple :: Matrix Double -> Matrix Int
wijSimple wij = map rowSimple wij

rowSimple [] = []
rowSimple rij = if (head rij) == 0 then [0] ++ rowSimple (tail rij) else [1] ++ rowSimple (tail rij)
		
findPP :: Matrix Double -> [Int]
findPP [] = []
findPP m = if (sum (head m)) == 0 then [1]++ findPP (tail m) else [0] ++ findPP (tail m)
--where m is transpose $ wijSimple $ wij fw

--outputs the row numbers of the trophic level put in
ppRowNumbers :: [(Int,Int)] -> [Int]
ppRowNumbers [] = []
ppRowNumbers zpp = if snd  (head zpp) == 1 then [fst (head zpp)]++ ppRowNumbers (tail zpp) else ppRowNumbers (tail zpp)
	--where zpp = zip [1::Int ..] (findPP wij)

trophicElem :: Matrix Double -> Matrix Double -> Int -> Int -> Double
trophicElem z w i j | w!!i!!j ==0 = 0
		  | otherwise = 1+sum0 [z!!m!!i | m<-[0..(length w -1)]]



trophicMatrixZ :: Matrix Double -> Matrix Double
trophicMatrixZ w = z
	where len = length w
 	      z = [[trophicElem  z w i j | j <- [0..len-1]]| i <-[0..len-1] ]
 	      
 	      

drawFoodweb :: FilePath -> IO ()
drawFoodweb fp = do
	fw<-fileToFoodweb fp
	let nms =  createNodeNames fw
	let ranks = createNodeTL fw
	let edges =  concat $ createEdges fw
	let pp = createPPRank fw
	let res = "digraph{\nrankdir=BT;\ngraph[label=" ++ show (dropExtension fp) ++ "];\n" ++  nms ++ "\n" ++ ranks ++ "\n" ++ pp ++" \n" ++ edges ++"}" -- error at ranks
	writeFile (dropExtension fp ++ ".dot") res



createEdges :: Foodweb -> [String]
createEdges fw = [if (wij fw)!!i!!j /= 0 then (show i) ++ "->" ++ (show j) ++ ";" else "" |i<-[0..(length (names fw) -1)], j<-[0..(length (names fw) -1)]]


createNodeTL :: Foodweb -> String
createNodeTL fw = concat $ map outputTL (nodeTL fw)

createPPRank :: Foodweb -> String
createPPRank fw = concat $ ["{rank=source;"] ++[if tls!!i == 1 then show i ++ ";" else "" |i<-[0..(length (names fw) -1)]] ++ ["}"] 
		where tls=map (+1) $ map sum0 $transpose (trophicMatrixZ (wij fw))

outputTL :: (Integer, Double) -> String
outputTL tp = "{rank=" ++ show (snd tp) ++ ";" ++ show (fst tp) ++ ";}" 

nodeTL :: Foodweb -> [(Integer,Double)]
nodeTL fw =  zip [0..] tls
	where tls = map (+1) $ map sum0 $transpose (trophicMatrixZ (wij fw))

createNodeNames :: Foodweb -> String
createNodeNames fw = concat $  map nameLabel (zip [0..] (names fw)) 

nameLabel :: (Integer,String) -> String
nameLabel tp =  show (fst tp) ++ "[label=" ++  (snd tp) ++ "];"

writeTLMatrix :: FilePath -> IO ()
writeTLMatrix fp = do
	fw<-fileToFoodweb fp
	let res = trophicMatrixZ (wij fw)
	writeFile ( dropExtension fp ++ ".tl") (outputMatrix $matrixDoubleToString $ res)
	
count0 :: [Double] -> Double
count0 [] = 0
count0 (x:xs) = if x == 0 then count0 xs else 1+ count0 xs

sum0 :: [Double] -> Double
sum0 x = if count0 x == 0 then 0 else sum(x)/count0 x

--------------------------------------------------------------------------------
--generating fig 2 from anje 1995 paper

fig2 :: FilePath -> IO ()
fig2 fp = do
	fw1<-fileToFoodweb fp
	let fw = putCM fw1
	    f = fij (info fw) (wij fw)
	    a = cm fw
	    n = names fw
	    title = "Predator \t Fij \t aij \t aji \t Prey \n"
	    contents =  concat$ [if (wij fw)!!i!!j /= 0 then n!!i ++ "\t" ++ show ( f!!i!!j) ++ "\t"  ++   show (a!!i!!j) ++ "\t" ++ show( a!!j!!i) ++ "\t" ++  n!!j ++ "\n"  else "" |i<-[0..(length (names fw) -1)], j<-[0..(length (names fw) -1)]]
	    res = title ++ contents
	writeFile (dropExtension fp ++ ".fig2") res
--------------------------------------------------------------------------------
--generating biomass ratios of mlw3 loop for a directory of files
{--} -- problem is generating them for a directory
getBiomassRatio :: FilePath -> Int -> IO ()
getBiomassRatio fp ll1 = do
	fw<-fileToFoodweb fp
	--getLoopyInfo fp
	x <-readLoopPropFile (dropExtension fp ++ ".log")
	let ll = if ll1 >(1+(length x)) then 2 else ll1
	let loop = read (x!!(ll-2)!!8)::[Int]
	    tls = map snd $ nodeTL fw
	    i = info fw
	    b =map biomass i
	    zp =zip [tls!!(loop!!i) | i<-[0..(ll-1)]] [b!!(loop!!i) | i<-[0..(ll-1)]] 
	    pmax = snd $ maximum zp
	    pmin = snd $ minimum zp
	writeFile (dropExtension fp ++ ".br" ) (show (pmax/pmin))
	--putStr (show (pmax/pmin))
	return ( )


writeBiomassRatios :: FilePath -> IO ()
writeBiomassRatios fp= do
	stabs<- readStabs fp
	brs<-readBrs fp
	let res = zip stabs brs
	writeFile (dropExtension fp ++ ".stabBr") (tableTuple res)	

writeBrs :: FilePath -> Int -> IO ()
writeBrs fp ll= do
	allfiles <- getDirectoryContents fp
	let ss = filter (\x -> takeExtension x == ".fw") allfiles
	res<- sequence [getBiomassRatio (fp </> s) ll| s <- ss]
	return()
{--}

readBrs :: FilePath -> IO [Double]
readBrs fp = do
	allfiles <- getDirectoryContents fp
	let ss = filter (\x -> takeExtension x == ".br") allfiles
	res<- sequence [readBr (fp </> s)| s <- ss]
	stabs<-return $ res
	return(stabs)
	

readBr :: FilePath -> IO Double -- checked ok
readBr x = do
	s<-readFile $x--fp</>x
	let y =read s :: Double
	return(y)