Skip to content

Commit

Permalink
Price at metier level
Browse files Browse the repository at this point in the history
  • Loading branch information
@dorleta
dorleta committed May 30, 2024
1 parent bc4f1fc commit f901231
Show file tree
Hide file tree
Showing 3 changed files with 32 additions and 31 deletions.
1 change: 1 addition & 0 deletions R/MP_3c_HCR_ICES_MSY.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -164,6 +164,7 @@ IcesHCR <- function(stocks, advice, advice.ctrl, year, stknm,...){

print(Ftg)


if(is.na(Ftg) | Ftg == 0){
advice[['TAC']][stknm,year+1,,,,i] <- 0
next
Expand Down
34 changes: 19 additions & 15 deletions R/OM_2_fleet.om.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,15 +25,15 @@ fleets.om <- function(fleets, biols, BDs, covars, advice, biols.ctrl, fleets.ctr
fleets.ctrl.aux <- fleets.ctrl


# update weights if DDW function applied in any of the stocks
if(!(is.null(covars$DDW))) {
# update weigths if DDW function applied in any of the stocks
if(!(is.null(covars$DDW))){
for(st in names(covars$DDW)){
for(fl in names(which(sapply(lapply(fleets, catchNames), function(x) (st %in% x))))) {
for(mt in names(which(sapply(lapply(fleets[[fl]]@metiers, catchNames), function(x) (st %in% x))))) {
mult <- covars[['DDW']][[st]][,year,,season,]
fleets[[fl]]@metiers[[mt]]@catches[[st]]@landings.wt[,year,,season,] <- mult*fleets[[fl]]@metiers[[mt]]@catches[[st]]@landings.wt[,year,,season,]
fleets[[fl]]@metiers[[mt]]@catches[[st]]@discards.wt[,year,,season,] <- mult*fleets[[fl]]@metiers[[mt]]@catches[[st]]@discards.wt[,year,,season,]
}
for(fl in names(which(sapply(lapply(fleets, catchNames), function(x) (st %in% x))))){
for(mt in names(which(sapply(lapply(fleets[[fl]]@metiers, catchNames), function(x) (st %in% x))))){
mult <- covars[['DDW']][[st]][, year]
fleets[[fl]]@metiers[[mt]]@catches[[st]]@landings.wt[, year] <- mult*fleets[[fl]]@metiers[[mt]]@catches[[st]]@landings.wt[, year]
fleets[[fl]]@metiers[[mt]]@catches[[st]]@discards.wt[, year] <- mult*fleets[[fl]]@metiers[[mt]]@catches[[st]]@discards.wt[, year]
}
}
}
}
Expand All @@ -58,7 +58,7 @@ fleets.om <- function(fleets, biols, BDs, covars, advice, biols.ctrl, fleets.ctr
year = year, season = season, biols.ctrl=biols.ctrl, fleets.ctrl = fleets.ctrl, covars = covars,
assess.ctrl=assess.ctrl, advice.ctrl = advice.ctrl))

fleets[[fl]] <- res$fleets[[fl]]
fleets[[fl]] <- res$fleets[[fl]]
fleets.ctrl.aux[[fl]] <- res$fleets.ctrl[[fl]]
remove(res)
}
Expand All @@ -76,17 +76,21 @@ fleets.om <- function(fleets, biols, BDs, covars, advice, biols.ctrl, fleets.ctr

fleets <- unclass(fleets)
for(fl in flnms){
print(fl)

sts <- catchNames(fleets[[fl]])
print(fl)
mtnms <- names(fleets[[fl]]@metiers)

for(mt in mtnms){
print(mt)
stnms <- names(fleets[[fl]]@metiers[[mt]]@catches)

for(st in sts){
dyn.model <- fleets.ctrl[[fl]][[st]]$price.model
for(st in stnms){
dyn.model <- fleets.ctrl[[fl]][[mt]][[st]]$price.model

res <- eval(call(dyn.model, fleets = fleets, flnm = fl, stnm = st, year = year, season = season, fleets.ctrl = fleets.ctrl, covars = covars))
res <- eval(call(dyn.model, fleets = fleets, flnm = fl, mtnm = mt, stnm = st, year = year, season = season, fleets.ctrl = fleets.ctrl, covars = covars))

fleets[[fl]] <- res[[fl]]
}
}
}
fleets <- FLFleetsExt(fleets)

Expand Down
28 changes: 12 additions & 16 deletions R/OM_2c_Price_Dynamics.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,15 +27,15 @@ fixedPrice <- function(fleets, covars, fleets.ctrl, year = 1, season = 1,...){
# sophisticated function
#-------------------------------------------------------------------------------

elasticPrice <- function(fleets, covars, fleets.ctrl, stnm, flnm, year = 1, season = 1){
elasticPrice <- function(fleets, covars, fleets.ctrl, stnm, flnm, mtnm, year = 1, season = 1){

# Parameters
elas <- fleets.ctrl[[flnm]][[stnm]][['pd.els']][,season,] # [na,it] the price and its parameters depend on season.
La0 <- fleets.ctrl[[flnm]][[stnm]][['pd.La0']][,season,] # [na,it] the price and its parameters depend on season.
Pa0 <- fleets.ctrl[[flnm]][[stnm]][['pd.Pa0']][,season,] # [na,it] the price and its parameters depend on season.
total <- fleets.ctrl[[flnm]][[stnm]][['pd.total']] # Logic: The function depends on total landings or fleet's landings
elas <- fleets.ctrl[[flnm]][[mtnm]][[stnm]][['pd.els']][,season,] # [na,it] the price and its parameters depend on season.
La0 <- fleets.ctrl[[flnm]][[mtnm]][[stnm]][['pd.La0']][,season,] # [na,it] the price and its parameters depend on season.
Pa0 <- fleets.ctrl[[flnm]][[mtnm]][[stnm]][['pd.Pa0']][,season,] # [na,it] the price and its parameters depend on season.
total <- fleets.ctrl[[flnm]][[mtnm]][[stnm]][['pd.total']] # Logic: The function depends on total landings or fleet's landings

f <- fleets[[flnm]]
fms <- fleets[[flnm]][[mtnm]][[stnm]]
yr <- year
ss <- season

Expand All @@ -45,29 +45,25 @@ elasticPrice <- function(fleets, covars, fleets.ctrl, stnm, flnm, year = 1, seas
Lau <- landWStock(fleets, stnm)[,yr,,ss]
# print('TOTAL')
}else{
Lau <- landWStock.f(f, stnm)[,yr,,ss]
Lau <- fms@landings.wt
# print('FLEET')
}

La <- unitSums(Lau)[drop=T] # [na,it]
nu <- dim(Lau)[3]

La[La==0] <- 0.1
La[La==0] <- 0.001

Pa <- Pa0*(La0/La)^elas # [na,it]

# When La = 0 -> Pa = Inf -> set Pa = NA
Pa <- ifelse( Pa==Inf, NA, Pa)

for(mt in 1:length(f@metiers)){

if(!(stnm %in% names(f@metiers[[mt]]@catches))) next

for(i in 1:nu)
f@metiers[[mt]]@catches[[stnm]]@price[,yr,i,ss] <- Pa
}
fms@price[,yr,i,ss] <- Pa


fleets[[flnm]] <- f
fleets[[flnm]]@metiers[[mtnm]]@catches[[stnm]] <- fms

return(fleets)
}

0 comments on commit f901231

Please sign in to comment.