R/reduce.r

In PacificCommunity/ofp-sam-flr4mfcl: R Functions for Taming MULTIFAN-CL

#####################################################
##
## Functions to produce - Skipjack single area MFCL input files for regions 2,3 and 5
## Uses tag data from the PTTP only
##
## 12 fleets, 1 area, 
## corresponding doitall - single_area_doitall_v1.skj
##
## 09/01/2017 - rds
##
##
######################################################


setGeneric('reduce', function(obj, ...) standardGeneric('reduce')) 


setMethod("reduce", signature(obj='MFCLFrq'),
          function(obj, fisheries=1:n_fisheries(obj), ...){
            
  frq2 <- obj
  n_regions(frq2)     <- 1
  n_fisheries(frq2)   <- length(fisheries)
  #n_tag_groups(frq2)  <- release_groups(tag2)
  region_size(frq2)   <- FLQuant(1)
  region_fish(frq2)[] <- 1
  region_fish(frq2)   <- trim(region_fish(frq2), unit=fisheries)
  data_flags(frq2)    <- data_flags(obj)[,fisheries]
  move_matrix(frq2)   <- matrix()
  season_flags(frq2)  <- t(season_flags(obj)[,1])
  move_weeks(frq2)    <- 1
  n_move_yr(frq2)      <- 1
  
  # chop out the fisheries in regions 1 and 4
  freq(frq2) <- freq(obj)[is.element(freq(obj)$fishery, fisheries),]
  
  # renumber the fisheries in the freq
  #freq(frq2)$fishery <- freq(frq2)$fishery-3   ### this is a hack - be careful
  freq(frq2)$fishery <- rep(1:length(fisheries), table(freq(obj)$fishery)[fisheries])
  
  lf_range(frq2)["Datasets"] <- nrow(freq(frq2)[freq(frq2)$length==range(frq2)["min"] | is.na(freq(frq2)$length),])
  
  return(frq2)
})


setMethod("reduce", signature(obj='MFCLTag'),
          function(obj, fisheries=4:15, regions=c(2,3,5), programs="PTTP", ...){
  
  # remove all releases from regions 1 and 4
  #releases.new <- releases(obj)[is.element(releases(obj)$region, regions & is.element(releases(obj)$program, programs)),]
  releases.new <- releases(obj)[is.element(releases(obj)$region, regions),]
  
  # remove all recaptures for releases from regions 1 and 4 and recaptures in 1 and 4
  recaptures.new <- recaptures(obj)[is.element(recaptures(obj)$region,          regions)   & 
                                      is.element(recaptures(obj)$recap.fishery, fisheries),] # &
                                      #is.element(recaptures(obj)$program,       "PTTP"),] 
  
  # Ideally release tags should be reduced to account for tags recaptured outside of assessment area (regions 1 and 4) - but only 1.5% so skipping for the time being.
  
  # mapping the release groups 
  rel.map <- cbind(unique(releases.new$rel.group), 1:length(unique(releases.new$rel.group)))
  
  # renumber the release groups (making sure to match the release group numbers for both releases and recaptures)
  releases.new$rel.group   <- match(releases.new$rel.group,   unique(releases.new$rel.group))
  
  new.rec.rel.grp <- rel.map[is.element(rel.map[,1],recaptures.new$rel.group),2]
  recaptures.new$rel.group <- rep(new.rec.rel.grp, table(recaptures.new$rel.group))
  
  # renumber the recapture fisheries
  recaptures.new$recap.fishery <- recaptures.new$recap.fishery-3    # this is a hack - be careful- may not work for different fishery selections
  
  releases.new$region <- 1    # since we only have one assessment region now
  recaptures.new$region <- 1
  
  # put revised stuff into new tag object
  tag2 <- obj
  release_groups(tag2) <- max(releases.new$rel.group)
  
  # re-calculate number of recapture strata for each tag group
  rr   <- rep(0, release_groups(tag2))
  rval <- tapply(recaptures.new$recap.number, recaptures.new$rel.group, length)
  rr[as.numeric(names(rval))] <- rval
  
  recoveries(tag2) <- rr
  
  releases(tag2)   <- releases.new
  recaptures(tag2) <- recaptures.new
  
  return(tag2)
})


#setMethod("reduce", signature(obj='MFCLIni'),
#          function(obj, tag, fisheries, regions, programs, ...){
  
#  ini2 <- obj
  
  # identify the release groups you have removed.
  #release.grps.in <- rel.map[,1]  #unique(releases(tag)[is.element(releases(tag)$region, c(2,3,5)),]$rel.group)
#  releases.new <- releases(tag)[is.element(releases(tag)$region, regions) & is.element(releases(tag)$program, programs),]
#  rel.map <- cbind(unique(releases.new$rel.group), 1:length(unique(releases.new$rel.group)))
#  release.grps.in  <- c(is.element(1:release_groups(tag), rel.map[,1]), TRUE)
  
  # chop out the tag reporting stuff for the release groups you have removed.
#  tag_fish_rep_rate(ini2)   <- tag_fish_rep_rate(obj)[release.grps.in,  fisheries]
#  tag_fish_rep_grp(ini2)    <- tag_fish_rep_grp(obj)[release.grps.in,   fisheries]
#  tag_fish_rep_flags(ini2)  <- tag_fish_rep_flags(obj)[release.grps.in, fisheries]
#  tag_fish_rep_target(ini2) <- tag_fish_rep_target(obj)[release.grps.in,fisheries]
#  tag_fish_rep_pen(ini2)    <- tag_fish_rep_pen(obj)[release.grps.in,   fisheries]
  
  # re-order the tag rep group numbers to start from 1 and be continuous
#  tag_fish_rep_grp(ini2) <- matrix(match(tag_fish_rep_grp(ini2), sort(unique(c(tag_fish_rep_grp(ini2))))), 
#                                   nrow=nrow(tag_fish_rep_grp(ini2)))
  
#  move_map(ini2)   <- 0
#  diff_coffs(ini2) <- matrix(0)
#  rec_dist(ini2)   <- 1
  
#  return(ini2)
#})

setMethod("reduce", signature(obj='MFCLIni'),
          function(obj, tagx, years=NULL, regions=NULL, programs=NULL, fsh.rgn.map=NULL){
  
  inix <- obj            
  ini2 <- inix
  map  <- cbind(fishery=1:ncol(tag_fish_rep_rate(inix)), region=fsh.rgn.map) # maps the fisheries for the regions that you want to retain
  
  releases.new <- releases(tagx)
  # strip out the release groups you want to remove.
  if(!is.null(regions))
    releases.new <- releases.new[is.element(releases.new$region, regions), ] 
  if(!is.null(programs))
    releases.new <- releases.new[is.element(releases.new$program, programs) ,]
  if(!is.null(years))
    releases.new <- releases.new[is.element(releases.new$year, years), ]
  
  # remove release groups in final year of object - can't have releases in terminal yr - see window for tag objects
  releases.new <- releases.new[!is.element(releases.new$year, max(years)),]
  
  #rel.map <- cbind(unique(releases.new$rel.group), 1:length(unique(releases.new$rel.group)))
  release.grps.in  <- c(is.element(1:release_groups(tagx), releases.new$rel.group), TRUE)
  release.grps.out <- c(!is.element(1:release_groups(tagx), releases.new$rel.group), FALSE)
  
  sim.releases <- (dim(tag_fish_rep_grp(inix))[1]) - length(release.grps.in)
  vv           <- NULL
  if(sim.releases>0)
    vv <- as.logical(rep(0, sim.releases))
  
  # chop out the tag reporting stuff for the release groups you have removed.
  if(is.null(regions))
    fisheries <- map[,'fishery']
  if(!is.null(regions))
    fisheries <- map[is.element(map$region, regions), 'fishery']
  
  tag_fish_rep_rate(ini2)   <- tag_fish_rep_rate(inix)[c(release.grps.in,vv),  fisheries]
  tag_fish_rep_grp(ini2)    <- tag_fish_rep_grp(inix)[c(release.grps.in,vv),   fisheries]
  tag_fish_rep_flags(ini2)  <- tag_fish_rep_flags(inix)[c(release.grps.in,vv), fisheries]
  tag_fish_rep_target(ini2) <- tag_fish_rep_target(inix)[c(release.grps.in,vv),fisheries]
  tag_fish_rep_pen(ini2)    <- tag_fish_rep_pen(inix)[c(release.grps.in,vv),   fisheries]
  
  # re-order the tag rep group numbers to start from 1 and be continuous
  tag_fish_rep_grp(ini2) <- matrix(match(tag_fish_rep_grp(ini2), sort(unique(c(tag_fish_rep_grp(ini2))))), 
                                   nrow=nrow(tag_fish_rep_grp(ini2)))
  
  #move_map(ini2)   <- 0
  #diff_coffs(ini2) <- matrix(0)
  #rec_dist(ini2)   <- 1
  
  return(ini2)
          })