loopy-0.0: Avalon.hs

{-# LANGUAGE ScopedTypeVariables #-}
module Avalon 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


--not finished yet
changeChemoProp :: Foodweb -> Double -> Double -> Foodweb --first is frondose, second is rangeomorph prop osmo
changeChemoProp (Foodweb names info wij cm) cf cr = Foodweb names (changeInfo info) (changeWij wij) cm
	where
		changeInfo (fl:fm:fs:rl:rm:rs:rest) = frond fl: frond fm : frond fs : rangeo rl: rangeo rm: rangeo rs: rest
		 where
			frond x = x{aeff =(cf*0.3+(1-cf)*0.8) , peff =(cf*0.8+(1-cf)*0.3) }
			rangeo x = x{aeff =(cr*0.3+(1-cr)*0.8) , peff =(cr*0.8+(1-cr)*0.3) }

		changeWij wij = mapMatrixInd f wij
		 where
			f i j x|i==11 && j >= 1 && j <=3 =cf*100 --  |i==12 && j >= 1 && j <=3 =cr*100
			       |i==11 && j >= 4 && 6 <=3 =cf*100 --  |i==12 && j >= 1 && j <=3 =cr*100
			       |otherwise = x

createChemoRange :: FilePath -> Int-> IO ()
createChemoRange fp n = do
	fw <- readFoodweb fp
	createDirectoryIfMissing True (dropExtension fp ++ "ChemoRange")
	sequence_ [writeFoodweb file $ changeChemoProp fw x y
		| x <- [0,1/(fromIntegral n)..1], y <- [0,1/(fromIntegral n)..1], let file = dropExtension fp ++ "ChemoRange"</> dropExtension fp ++ "_" ++ show3dp x ++ "_" ++ show3dp y ++ ".fw"]


createOsmoRange :: FilePath -> Int-> IO ()
createOsmoRange fp n = do
	fw <- readFoodweb fp
	createDirectoryIfMissing True (dropExtension fp ++ "OsmoRange")
	sequence_ [writeFoodweb file $ changeFeedingStrategy fw x y
		| x <- [0,1/(fromIntegral n)..1], y <- [0,1/(fromIntegral n)..1], let file = dropExtension fp ++ "OsmoRange"</> dropExtension fp ++ "_" ++ show3dp x ++ "_" ++ show3dp y ++ ".fw"]

createOsmoRange2 :: FilePath -> Int-> IO ()
createOsmoRange2 fp n = do
	fw <- readFoodweb fp
	createDirectoryIfMissing True (dropExtension fp ++ "OsmoRange2")
	sequence_ [writeFoodweb file $ changeFS2 fw x y
		| x <- [0,1/(fromIntegral n)..1], y <- [0,1/(fromIntegral n)..1], let file = dropExtension fp ++ "OsmoRange2"</> dropExtension fp ++ "_" ++ show3dp x ++ "_" ++ show3dp y ++ ".fw"]


{-
createFeedingRange :: FilePath -> [Int]-> IO ()
createFeedingRange fp = do
	fw <- return$ fileToFoodweb fp
	--createDirectoryIfMissing True (dropExtension fp ++ "SpeciesRange")
	let file = [dropExtension fp ++ "SpeciesRange"</> dropExtension fp ++ ".fw"]
	writeFoodweb file $ changeFeeding fw [2,2,2,3,3,3]
	return()
-}	
changeFeeding :: Foodweb -> [Int] -> Foodweb
changeFeeding (Foodweb names info wij cm) fts  = Foodweb names (changeInfoSp info fts) (changeWijSp wij fts ((length names))) cm -- note that cm will be wrong

generateFeedingTypes :: Int -> [[Int]]
generateFeedingTypes n = undefined --[k|k<-(replicate n i) && i<-[1..3] ]
	
changePlanktonicBiomass :: Foodweb -> [Double] -> Foodweb
changePlanktonicBiomass (Foodweb names info wij cm) bm = Foodweb names (changeBiomass info) wij cm
	where
		changeBiomass (a:b:c:d:e:f:p:hb:ppp:rest) = a:b:c:d:e:f:pro p:het hb:prim ppp:rest
		 where
		 	pro x = x{biomass =bm!!1}
		 	het x =x{biomass =bm!!2}
		 	prim x =x{biomass =bm!!3}
----update to include chemo stuff		 	
changeInfoSp :: [Info] -> [Int] -> [Info]
changeInfoSp is [] = basicInfo is
changeInfoSp (i:is) (ft:fts) = [change1 i ft] ++ changeInfoSp is fts
	where 
		change1 x t = if t==1 then  x{aeff =0.3 , peff =0.8 } else
				if t==2 then x{aeff = 0.8 , peff = 0.11 } else
				 x{aeff =1 , peff =0.3 } 

----update to include chemo stuff		 	
changeWijSp :: Matrix Double -> [Int] -> Int -> Matrix Double
changeWijSp ws [] det = ws
changeWijSp wij fts det= mapMatrixInd f wij  -- det is detrius row, found using getDetRow
		 where
			n = 5 + length fts
			stPl = length fts
			enPl = length fts + 3
			chemo = [i| (i,j)<- zip [1..] fts, j ==1]
			sf = [i| (i,j)<- zip [1..] fts, j ==2]
			osmo = [i| (i,j)<- zip [1..] fts, j ==3]
			f i j x|i >stPl && i <=enPl && j `elem` sf =33.33
			       |i ==det &&  j `elem` osmo =100
			       |otherwise = x


--returns just a list of the last 5 info
basicInfo :: [Info] -> [Info]
basicInfo (i:is) = if (length (i:is))> 5 then basicInfo is else (i:is)
{-----

-} 


outputAlpha :: FilePath -> IO ()
outputAlpha fp = do
	fw1<- readFoodweb fp
	let fw = checkFoodweb fw1
	let alpha = getCommat fw
	writeFile (dropExtension fp  ++".alpha") (outputMatrix $ matrixDoubleToString alpha)
	return()
   -- print $ alphaijElem info wij res 14 0
	

checkFoodweb :: Foodweb -> Foodweb
checkFoodweb fw = deleteSps fw b0
	where b0 = [i | (i,j) <- zip [0..] (info fw), biomass j == 0]--if biomass ==0 output col number


checkFoodweb2 :: Foodweb->Foodweb
checkFoodweb2 fw = fw{cm=getCommat fw}


getDetRow :: Foodweb -> [Int]
getDetRow fw =  [i | (i,j) <- zip [0..]  (info fw), deathRate j==0]
{-----}

			
changeInfo :: Foodweb -> Maybe Double ->Maybe Double -> Maybe [Double] -> Maybe [Double] -> Maybe Double-> Foodweb
changeInfo (Foodweb names info wij cm) marealCoverage mrFRatio msizeClassesF msizeClassesR mareaBiomassRatio = Foodweb names (change info) wij cm
	where change = if mrFRatio==Just 0 then changeF else
		       if mrFRatio==Just 1 then changeR else
		       changeInfo
		       where		
				changeInfo (fl:fm:fs:rl:rm:rs:rest) = frond fl 0: frond fm 1: frond fs 2: rangeo rl 0: rangeo rm 1: rangeo rs 2: rest--numbers refer to sizeclasses
				changeF (fl:fm:fs:rest) = frond fl 0: frond fm 1: frond fs 2: rest--numbers refer to sizeclasses
				changeR (rl:rm:rs:rest) = rangeo rl 0: rangeo rm 1: rangeo rs 2: rest--numbers refer to sizeclasses
				frond x y= x{biomass = (arealCoverage*(1-rFRatio)*(sizeClassesF!!y)*areaBiomassRatio)}
				rangeo x y= x{biomass = (arealCoverage*rFRatio*(sizeClassesR!!y)*areaBiomassRatio)}
				arealCoverage = fromMaybe 0.1 marealCoverage
				rFRatio = fromMaybe 0.5 mrFRatio
				sizeClassesR =  fromMaybe [0.95,0.045,0.005] msizeClassesR -- need to extend to rangeo and fronds
				sizeClassesF =  fromMaybe [0.9,0.09,0.01] msizeClassesF -- need to extend to rangeo and fronds
				areaBiomassRatio = fromMaybe 1000 mareaBiomassRatio	
changeFS2 :: Foodweb -> Double -> Double -> Foodweb --first is frondose, second is rangeomorph prop osmo
changeFS2 (Foodweb names info wij cm) cf cr = Foodweb names (changeInfo info) (changeWij wij) cm
	where
		changeInfo (sp1:sp2:rest) = species1 sp1: species2 sp2 : rest
		 where
			species1 x = x{aeff =(cf*1+(1-cf)*0.8) , peff =(cf*0.3+(1-cf)*0.11) }
			species2 x = x{aeff =(cr*1+(1-cr)*0.8) , peff =(cr*0.3+(1-cr)*0.11) }

		changeWij wij = mapMatrixInd f wij
		 where
			f i j x|i >=5 && i <=7 && j == 1 =(1-cf)*100
			       |i >=5 && i <=7 && j == 2 =(1-cr)*100
			       |i==9 && j ==1 =cf*100 --  |i==12 && j >= 1 && j <=3 =cr*100
			       |i==9 && j ==2 =cr*100 --  |i==12 && j >= 1 && j <=3 =cr*100
			       |otherwise = x

--needs create a food web before going in
changeFeedingStrategy :: Foodweb -> Double -> Double -> Foodweb --first is frondose, second is rangeomorph prop osmo
changeFeedingStrategy (Foodweb names info wij cm) cf cr = Foodweb names (changeInfo info) (changeWij wij) cm
	where
		changeInfo (fl:fm:fs:rl:rm:rs:rest) = frond fl: frond fm : frond fs : rangeo rl: rangeo rm: rangeo rs: rest
		 where
			frond x = x{aeff =(cf*1+(1-cf)*0.8) , peff =(cf*0.3+(1-cf)*0.11) }
			rangeo x = x{aeff =(cr*1+(1-cr)*0.8) , peff =(cr*0.3+(1-cr)*0.11) }

		changeWij wij = mapMatrixInd f wij
		 where
			f i j x|i >=7 && i <=9 && j >= 1 && j <=3 =(1-cf)*100
			       |i >=7 && i <=9 && j >= 4 && j <=6 =(1-cr)*100
			       |i==11 && j >= 1 && j <=3 =cf*100 --  |i==12 && j >= 1 && j <=3 =cr*100
			       |i==11 && j >= 4 && j <=6 =cr*100 --  |i==12 && j >= 1 && j <=3 =cr*100
			       |otherwise = x
----
--- changing the biomass in some way
-- three things influence the biomasses:
--(1) total biota coverage of bedding plane - default 0.10
--(2) prop of rangeo:frond - default 0.5
--(3) prop of size classes in each tier - default [0.9,0.09,0.01]
--(4) the area to biomass ratio - default 1000
--each size class is given by 1*2*3

changeBiomass :: Foodweb -> Maybe Double ->Maybe Double -> Maybe [Double] -> Maybe [Double] -> Maybe Double-> Foodweb
changeBiomass (Foodweb names info wij cm) marealCoverage mrFRatio msizeClassesF msizeClassesR mareaBiomassRatio = Foodweb names (changeInfo info) wij cm
	where		
		changeInfo (fl:fm:fs:rl:rm:rs:rest) = frond fl 0: frond fm 1: frond fs 2: rangeo rl 0: rangeo rm 1: rangeo rs 2: rest--numbers refer to sizeclasses
		frond x y= x{biomass = (arealCoverage*(1-rFRatio)*(sizeClassesF!!y)*areaBiomassRatio)}
		rangeo x y= x{biomass = (arealCoverage*rFRatio*(sizeClassesR!!y)*areaBiomassRatio)}
		arealCoverage = fromMaybe 0.1 marealCoverage
		rFRatio = fromMaybe 0.5 mrFRatio
		sizeClassesR =  fromMaybe [0.95,0.045,0.005] msizeClassesR -- need to extend to rangeo and fronds
		sizeClassesF =  fromMaybe [0.9,0.09,0.01] msizeClassesF -- need to extend to rangeo and fronds
		areaBiomassRatio = fromMaybe 1000 mareaBiomassRatio		

changeBiomass2 :: Foodweb -> Maybe Double ->Maybe Double -> Maybe [Double] -> Maybe [Double] -> Maybe Double-> Foodweb
changeBiomass2 (Foodweb names info wij cm) marealCoverage mrFRatio msizeClassesF msizeClassesR mareaBiomassRatio = changeInfo (changeFoodweb (Foodweb names info wij cm) mrFRatio) marealCoverage mrFRatio msizeClassesF msizeClassesR mareaBiomassRatio 

changeFoodweb :: Foodweb -> Maybe Double-> Foodweb
changeFoodweb fw r =  if r == Just 0 --r is the ratio of rangeomorphs to fronds
		then
		deleteSp (deleteSp (deleteSp fw 3) 3) 3
		else
			if r == Just 1
			then
			deleteSp (deleteSp (deleteSp fw 0) 0) 0
			else
			fw



fileToFoodweb2 :: FilePath -> IO Foodweb
fileToFoodweb2 fp = do
	y <- fileToFoodweb fp 
	return $ y{cm=getCommat y} -- FIXME: Reorder to remove this

{-
-}
--takes away any zero biomass species NEED TO FINISH THIS OFF PROPERLY




--needs to be an ordered list
deleteSps :: Foodweb -> [Int] -> Foodweb
deleteSps fw [] = fw
deleteSps fw spNu = deleteSps (deleteSp fw (head spNu)) (reduceListNu (tail spNuO))
	where spNuO = spNu
	
reduceListNu :: [Int] -> [Int]
reduceListNu [] = []
reduceListNu (x:xs) = [x-1] ++ reduceListNu xs 
	
deleteSp :: Foodweb -> Int -> Foodweb
deleteSp (Foodweb names info wij cm) spNu = Foodweb (delListLine spNu names) (delListLine spNu info) (delListListLine spNu wij) cm  
		
delListLine :: Int->[a]->[a]
delListLine i xs =take i xs ++ drop (i+1) xs -- deleting line i from xs, with numbers starting at 0

delListListLine :: Int -> [[a]] -> [[a]]
delListListLine i xs = map (delListLine i) (delListLine i xs) 

createFrondRange :: FilePath -> Int -> Int -> IO () -- assumes fronds and rangeomorphs behave in the same way
createFrondRange fp n1 n2 = do
	fw <- readFoodweb fp
	createDirectoryIfMissing True (dropExtension fp ++ "FrondRange")
	sequence_ [writeFoodweb file $ changeFeedingStrategy (changeBiomass2 fw Nothing (Just y) Nothing Nothing Nothing) x x
		| x <- [0,1/(fromIntegral n1)..1], y <- [0,1/(fromIntegral n2)..1], let file = dropExtension fp ++ "FrondRange"</> dropExtension fp ++ "_" ++ show3dp y ++ "_" ++ show3dp x ++ ".fw"]