Issue39

README.md

@@ -279,3 +279,6 @@ _____________________________________________________________
 						Last changed on:
 						Source code: https://github.com/smartell/iSCAM
 _____________________________________________________________
+
+## Code Changes
+	- March 30, 2015.  Added time varying catchbility options (random walk).

examples/makeproject

@@ -28,10 +28,10 @@ gsed -i "0,/^CTL=/s/^CTL=/CTL=$1/"      $1/DATA/Makefile
 
 cp ../scripts/Template.dat      		$1/DATA/$1.dat
 cp ../scripts/Template.ctl      		$1/DATA/$1.ctl
-cp ../scripts/Template.pfc   				$1/DATA/$1.pfc
-cp ../scripts/Template.mpc 					$1/DATA/$1.mpc
+cp ../scripts/Template.pfc   			$1/DATA/$1.pfc
+cp ../scripts/Template.mpc 				$1/DATA/$1.mpc
 cp ../scripts/Template.scn 	    		$1/DATA/$1.scn
-cp ../scripts/buildRdata.R 					$1/R/buildRdata.R
+cp ../scripts/buildRdata.R 				$1/R/buildRdata.R
 cp ../scripts/collectAll.R      		$1/R/collectAll.R
 cp ../scripts/saveMSEdataframe.R		$1/R/saveMSEdataframe.R
 

fba/HALIBUT/DATA/DMVL1888/Halibut2014.ctl

@@ -125,7 +125,7 @@
 2.0       # 3  -std in observed catches in first phase.
 1.0       # 4  -std in observed catches in last phase.
 1         # 5  -Assume unfished in first year (0=FALSE, 1=TRUE)
-0.00      # 6  -Minimum proportion to consider in age-proportions for dmvlogistic
+1.00      # 6  -Maternal effects power parameter (1.0 = no maternal effects)
 0.30      # 7  -Mean fishing mortality for regularizing the estimates of Ft
 0.10      # 8  -std in mean fishing mortality in first phase
 2.00      # 9  -std in mean fishing mortality in last phase

fba/HALIBUT/R/R4iSCAM.R

@@ -27,6 +27,12 @@ setwd(.PWD)
 .THEME      <- theme_bw(12)
 .UNITS      <- "(mlb)"
 
+# | Labels for gear sex area and group index.
+.GEAR  = c("Directed","Wasteage","Bycatch","Sport","Personal","Setline Survey")
+.SEX   = c("F & M","Female","Male")
+.AREA  = c("Coast wide")
+.GROUP = c("Pacific Halibut")
+
 
 .srcRlib  <- function()
 {
@@ -59,19 +65,22 @@ for(nm in .RFILES) source(file.path(.LIB, nm), echo=FALSE)
 .plotCatch( M )
 .plotIndex( M )
 .plotWeightAtAge( M )
-.plotAgeComps( M )
-.plotAgeCompResiduals( M )
-.plotAgeSummary( M )
 .plotSpawnBiomass( M )
 .plotDepletion( M )
 .plotMortality( M )
 .plotRecruitment( M )
 .plotStockRecruit( M )
 .plotRecruitsPerSpawner( M )
 .plotSurveyFit( M )
+.plotQ( M )
 .plotCatchResidual( M )
 .plotIndexResidual( M )
 .plotRecruitmentResidual( M )
+.plotAgeComps( M )
+.plotAgeCompResiduals( M )
+.plotAgeSummary( M )
+.plotAgeBars( M )
+.plotSlx( M )
 
 # |----------------------------------------------------------------------------------|
 # | guiView: Main function for starting the iSCAM Gui

src/R/R4iSCAM.R

@@ -15,8 +15,8 @@
 # | .RFILES    <- List of R functions to source from the lib directory.
 # .PWD        <- "/Users/stevenmartell1/Documents/iSCAM/examples/PacificHake14/R"
 .PWD        <- "/Users/stevenmartell1/Documents/iSCAM-project/src/R"
-.LIB        <- "../../../dist/R/lib/"
-.WIN        <- "../../../dist/R/iScamWin2.txt"
+.LIB        <- "../../../src/R/lib/"
+.WIN        <- "../../../src/R/iScamWin2.txt"
 setwd(.PWD)
 .FIGUREDIR  <- "../FIGS/"
 .RFILES     <- list.files(.LIB,pattern="\\.[Rr]$")
@@ -37,19 +37,22 @@ for(nm in .RFILES) source(file.path(.LIB, nm), echo=FALSE)
 .plotCatch( M )
 .plotIndex( M )
 .plotWeightAtAge( M )
-.plotAgeComps( M )
-.plotAgeCompResiduals( M )
-.plotAgeSummary( M )
 .plotSpawnBiomass( M )
 .plotDepletion( M )
 .plotMortality( M )
 .plotRecruitment( M )
 .plotStockRecruit( M )
 .plotRecruitsPerSpawner( M )
 .plotSurveyFit( M )
+.plotQ( M )
 .plotCatchResidual( M )
 .plotIndexResidual( M )
 .plotRecruitmentResidual( M )
+.plotAgeComps( M )
+.plotAgeCompResiduals( M )
+.plotAgeSummary( M )
+.plotAgeBars( M )
+.plotSlx( M )
 
 
 # |----------------------------------------------------------------------------------|

src/R/lib/plotAgeBars.R

@@ -0,0 +1,70 @@
+# plotAgeBars.R
+library(reshape2)
+library(ggplot2)
+
+
+.plotAgeBars <- function( M )
+{
+	n <- length( M )
+	cat(".plotAgeBars\n")
+	id <- grep("d3_A[1-9]",names(M[[1]]))
+	iu <- grep("A_hat[1-9]",names(M[[1]]))
+	hr <- c("Year","Gear","Area","Group","Sex","AgeErr")
+	mdf <- NULL
+	mcol<- -1:-7
+	for(i in 1:n)
+	{
+		getDF <- function(x)
+		{
+			ix <- id[x]
+			jx <- iu[x]
+
+			age <- seq(M[[i]]$n_A_sage[x],M[[i]]$n_A_nage[x])
+			df  <- data.frame(V="Observed",M[[i]][[ix]])
+			df[,mcol] <- df[,mcol]/rowSums(df[,mcol],na.rm=TRUE)
+			# cat("\nSum of observed = ",rowSums(df[,-1:-6]))
+			colnames(df) = c("V",hr,paste(age))
+
+			dp  <- data.frame(V="Predicted",M[[i]][[ix]][,1:6],M[[i]][[jx]])
+			dp[,mcol] <- dp[,mcol]/rowSums(dp[,mcol],na.rm=TRUE)
+			# cat("\nSum of predicted = ",rowSums(dp[,-1:-6]))
+			colnames(dp) = c("V",hr,paste(age))
+
+			dfp <- rbind(df,dp)
+			dfp <- subset(dfp,Year %in% seq(M[[i]]$syr,M[[i]]$nyr))
+			return(dfp)
+		}
+
+		B  <- lapply(1:length(id),getDF)
+	}
+
+
+
+	barplot <- function(B)
+	{		
+		mB <- melt(B,id.vars=c("V",hr))
+		mB$BroodYear <- mB$Year - as.integer(mB$variable)
+
+
+		O <- subset(mB,V=="Observed")
+		I <- subset(mB,V=="Predicted")
+
+		klbl <- .GEAR[O$Gear]
+		albl <- .AREA[O$Area]
+		glbl <- .GROUP[O$Group]
+		slbl <- .SEX[O$Sex+1]
+
+		p <- ggplot(O,aes(variable,as.double(value),fill=BroodYear))
+		p <- p + geom_bar(stat="identity",alpha=0.7)
+		p <- p + scale_fill_distiller(type = "div")
+		p <- p + geom_line(data=I,aes(as.numeric(variable),value),color="red")
+		p <- p + labs(x="Age",y="Proportion")
+		p <- p + ggtitle(paste(klbl,":Area",albl,":Group",glbl,":Sex",slbl))
+		p <- p + guides(title.position = "top")
+		p <- p + facet_wrap(~Year)+coord_flip()
+		return (p + .THEME + theme(legend.position="top") + theme_bw(8))
+	}
+
+	P <- lapply(B,barplot)
+	print(P)
+}