Difference between revisions of "Benefit-risk assessment of Baltic herring and salmon intake"

From Testiwiki
Jump to: navigation, search
(→‎Health impact model (Monte Carlo))
(→‎Health impact model (Monte Carlo))
Line 283: Line 283:
 
* Model run 13.3.2017 produces totcases results but are not meaningful yet [http://en.opasnet.org/en-opwiki/index.php?title=Special:RTools&id=FqjfFcJGQ1ZUHcsy]
 
* Model run 13.3.2017 produces totcases results but are not meaningful yet [http://en.opasnet.org/en-opwiki/index.php?title=Special:RTools&id=FqjfFcJGQ1ZUHcsy]
 
* Model run 14.3.2017 with exposure graph [http://en.opasnet.org/en-opwiki/index.php?title=Special:RTools&id=Rpt6e8XtmK8F4m2i]
 
* Model run 14.3.2017 with exposure graph [http://en.opasnet.org/en-opwiki/index.php?title=Special:RTools&id=Rpt6e8XtmK8F4m2i]
 +
* Model run 14.3.2017 bugs not fixed [http://en.opasnet.org/en-opwiki/index.php?title=Special:RTools&id=xkGg9EqAAXpoOs27]
  
 
<rcode name="hia" graphics=1>
 
<rcode name="hia" graphics=1>
Line 303: Line 304:
 
               Index = j,
 
               Index = j,
 
               Class = class(get(i)@output[[j]]),
 
               Class = class(get(i)@output[[j]]),
−
               Loc.num = length(unique(get(i)@output[[j]])),
+
               NumLoc = length(unique(get(i)@output[[j]])),
−
              Na.num = sum(is.na(get(i)@output[[j]])),
 
 
               Locations = paste(head(unique(get(i)@output[[j]])), collapse = " ")
 
               Locations = paste(head(unique(get(i)@output[[j]])), collapse = " ")
 
             )
 
             )
Line 402: Line 402:
 
# Tarkastellaan totcases-laskennassa aluksi yksilöriskiä, ja vasta lopussa kerrotaan yksilötulokset yksilöiden edustamien ryhmien koolla.
 
# Tarkastellaan totcases-laskennassa aluksi yksilöriskiä, ja vasta lopussa kerrotaan yksilötulokset yksilöiden edustamien ryhmien koolla.
  
−
population <- Ovariable("population", data = data.frame(Result = 1))
+
population <- Ovariable(
 +
  "population",  
 +
  data = data.frame(
 +
    Country = c("DK",  "EST", "FI",  "SWE"),
 +
    Result = c(2400000, 500000, 2700000, 4000000)
 +
  )
 +
)
  
 
# Väkimäärä. TÄTÄ KÄYTETÄÄN disincidence-ovariablen suhteuttamisessa CHD:n suhteen.
 
# Väkimäärä. TÄTÄ KÄYTETÄÄN disincidence-ovariablen suhteuttamisessa CHD:n suhteen.
Line 451: Line 457:
  
 
# Drop nuisance indices because they use a lot of memory in oapply.
 
# Drop nuisance indices because they use a lot of memory in oapply.
−
dropp <- c("Response_metric", "Exposure_route", "Exposure_metric", "Exposure_unit")
+
ERF@output <- ERF@output[ERF@output$Age != "<14" , ]
 +
threshold@output <- threshold@output[threshold@output$Age != "<14" , ]
 +
dropp <- c("Age", "Response_metric", "Exposure_route", "Exposure_metric", "Exposure_unit")
 
ERF <- unkeep(EvalOutput(ERF), dropp, sources = TRUE)
 
ERF <- unkeep(EvalOutput(ERF), dropp, sources = TRUE)
 
threshold <- unkeep(EvalOutput(threshold), dropp, sources = TRUE)
 
threshold <- unkeep(EvalOutput(threshold), dropp, sources = TRUE)
 +
  
 
######################################## Tautiriski
 
######################################## Tautiriski
Line 533: Line 542:
  
 
# WHY ARE THERE RESPONSES THAT DO NOT MATCH WITH EXPOSURES?
 
# WHY ARE THERE RESPONSES THAT DO NOT MATCH WITH EXPOSURES?
−
 
−
totcases <- totcases * 2500000 # Scale to Finnish population
 
  
 
ggplot(totcases@output, aes(x = Response, weight = totcasesResult, fill = Gender))+
 
ggplot(totcases@output, aes(x = Response, weight = totcasesResult, fill = Gender))+
Line 542: Line 549:
 
   geom_density() + scale_x_log10() + theme_gray(base_size = 24)+
 
   geom_density() + scale_x_log10() + theme_gray(base_size = 24)+
 
   facet_wrap(~ Country)+labs(title = "Dioxin exposure (pg/d)")
 
   facet_wrap(~ Country)+labs(title = "Dioxin exposure (pg/d)")
 +
 +
 +
colnames(exposure@output)
  
 
temp <- oapply(totcases, cols = "Iter", FUN = mean)
 
temp <- oapply(totcases, cols = "Iter", FUN = mean)
Line 547: Line 557:
  
 
Loctable <- showLoctable()
 
Loctable <- showLoctable()
−
oprint(Loctable)
+
oprint(showLoctable())
−
 
+
View(Loctable[Loctable$Index == "Age",])
 
##################################################################################
 
##################################################################################
 
# Tapauskohtaiset postprosessoinnit
 
# Tapauskohtaiset postprosessoinnit
Line 602: Line 612:
 
    
 
    
 
   #!!+++++++++++++++++++++++++++++++++++++++++++++++++
 
   #!!+++++++++++++++++++++++++++++++++++++++++++++++++
−
  objects.store(indivrisk, pop, exposure, amount, ERF, threshold, silakka, disincidence, concentration, rivit)
+
#  objects.store(indivrisk, pop, exposure, amount, ERF, threshold, silakka, disincidence, concentration, rivit)
 
   #ii+++++++++++++++++++++++++++++++++++++++++++++++++
 
   #ii+++++++++++++++++++++++++++++++++++++++++++++++++
 
   cat("indivrisk, pop, exposure, amount, ERF, threshold, silakka, disincidence, concentration, rivit stored. \n")
 
   cat("indivrisk, pop, exposure, amount, ERF, threshold, silakka, disincidence, concentration, rivit stored. \n")
Line 612: Line 622:
 
   }
 
   }
 
} # if(FALSE)
 
} # if(FALSE)
 +
 +
######################################## TESTIALUE
 +
 +
totcases2 <- Ovariable("totcases", # This calculates the total number of cases in each population subgroup.
 +
  # The cases are calculated for specific (combinations of) causes. However, these causes are NOT visible in the result.
 +
  dependencies = data.frame(
 +
    Name = c(
 +
      "population", # Population divided into subgroups as necessary
 +
      "dose", # Exposure to the pollutants
 +
      "disincidence", # Incidence of the disease of interest
 +
      "RR", # Relative risks for the given exposure
 +
      "ERF", # Other ERFs than those that are relative to background.
 +
      "threshold", # exposure level below which the agent has no impact.
 +
      "frexposed" # fraction of population that is exposed
 +
    ),
 +
    Ident = c(
 +
      "Op_en2261/population", # [[Health impact assessment]]
 +
      "Op_en2261/dose",      # [[Health impact assessment]]
 +
      "Op_en5917/initiate",  # [[Disease risk]]
 +
      "Op_en2261/RR",        # [[Health impact assessment]]
 +
      "Op_en2031/initiate",  # [[Exposure-response function]]
 +
      "Op_en2031/initiate",  # [[Exposure-response function]]
 +
      "Op_en2261/frexposed"  # [[Health impact assessment]]
 +
    )
 +
  ),
 +
  formula = function(...) {
 +
   
 +
    test <- list()
 +
    ERF@marginal[colnames(ERF@output) %in% c("ERF_parameter", "Scaling")] <- FALSE # Make sure that these are not marginals
 +
   
 +
    ############### First look at the relative risks based on RR
 +
   
 +
    if(testforrow(RR,  dose)) { # If an ovariable whose nrow(ova@output) == 0
 +
      # is used in Ops, it is re-EvalOutput'ed, and therefore ERFrr*dose may have rows even if ERFrr doesn't.
 +
     
 +
      # takeout is a vector of column names of indices that ARE in population but NOT in the disease incidence.
 +
      # However, populationSource is kept because oapply does not run if there are no indices.
 +
      if(FALSE) {
 +
print("RR")                         
 +
print(head(dose@output))                         
 +
      if(class(population) == "ovariable") {
 +
        takeout <- setdiff(colnames(population@output)[population@marginal],
 +
                            colnames(disincidence@output)[disincidence@marginal]
 +
        )
 +
        if(length(takeout) > 0) {# Aggregate to larger subgroups.
 +
          pop <- oapply(population, NULL, sum, takeout)
 +
        } else {
 +
          pop <- population
 +
        }
 +
      } else {
 +
        takeout <- character()
 +
        pop <- population
 +
      }
 +
     
 +
      # pci is the proportion of cases across different population subroups
 +
      # based on differential risks and
 +
      # population sizes. pci sums up to 1 for each larger subgroup found in disincidence.
 +
      # See [[Population attributable fraction]].
 +
      pci <- population * RR
 +
print("pci1")                         
 +
print(head(pci@output))                         
 +
      # Divide pci by the values of the actually exposed group (discard nonexposed)
 +
      # The strange Ovariable thing is needed to change the name of temp to avoid problems later.
 +
      temp <- pci * Ovariable(data = data.frame(Result = 1))
 +
      if ("Exposcen" %in% colnames(temp@output)) {
 +
        temp@output <- temp@output[temp@output$Exposcen == "BAU" , ]
 +
        temp <- unkeep(temp, cols = "Exposcen", prevresults = TRUE, sources = TRUE)
 +
      }
 +
      temp <- unkeep(temp, prevresults = TRUE, sources = TRUE)
 +
      if(length(takeout) > 0) temp <- oapply(temp, NULL, sum, takeout)
 +
      #if(length(takeout) > 0) temp <- ooapply(temp, cols = takeout, FUN = "sum", use_plyr = TRUE)
 +
      # if(length(takeout) > 0) temp <- osum(temp, cols = takeout)
 +
print("temp")
 +
print(head(temp@output))                         
 +
      pci <- pci / temp
 +
      temp <- NULL
 +
      } # if(FALSE)     
 +
      # The cases are divided into smaller subgroups based on weights in pci.
 +
      # This is why the larger groups of population are used (pop instead of population).
 +
      out1 <- disincidence * population * (RR-1)/RR #unkeep(pci, prevresults = TRUE, sources = TRUE)
 +
#      out1 <- unkeep(out1, cols = "populationResult") # populationResult comes from pop and not from pci that actually contains
 +
      # the population weighting for takeout indices. Therefore it would be confusing to leave it there.
 +
#print("out1")
 +
#print(head(out1@output))
 +
      test <- c(test, out1)
 +
    }
 +
    out1 <- NULL
 +
   
 +
    ##########################################################################
 +
    ############# This part is about absolute risks (i.e., risk is not affected by background rates).
 +
   
 +
    # Unit risk (UR), cancer slope factor (CSF), and Exposure-response slope (ERS) estimates.
 +
   
 +
    UR <- ERF
 +
    UR@output <- UR@output[UR@output$ERF_parameter %in% c("UR", "CSF", "ERS") , ]
 +
    if(testforrow(UR, dose)) { # See RR for explanation.
 +
      UR <- threshold + UR * dose * frexposed # Actual equation
 +
      # threshold is here interpreted as the baseline response (intercept of the line). It should be 0 for
 +
      # UR and CSF but it may have meaningful values with ERS
 +
print("UR")                         
 +
print(head(dose@output))                         
 +
     
 +
      UR <- oapply(UR, NULL, sum, "Exposure_agent")
 +
     
 +
      UR <- population * UR
 +
      test <- c(test, UR)
 +
    }
 +
    UR <- NULL
 +
   
 +
    # Step estimates: value is 1 below threshold and above ERF, and 0 in between.
 +
    # frexposed cannot be used with Step because this may be used at individual and maybe at population level.
 +
    Step <- ERF
 +
    Step@output <- Step@output[Step@output$ERF_parameter %in% c("Step", "ADI", "TDI", "RDI", "NOAEL") , ]
 +
    if(testforrow(Step, dose)) { # See RR for explanation.
 +
      Step <- 1 - (dose >= threshold) * (dose <= Step) # Actual equation
 +
      # Population size should be taken into account here. Otherwise different population indices may go unnoticed.(?)
 +
     
 +
      Step <- oapply(Step, NULL, sum, "Exposure_agent")
 +
     
 +
      test <- c(test, Step)
 +
    }
 +
    Step <- NULL
 +
   
 +
    #####################################################################
 +
    # Combining effects
 +
    if(length(test) == 0) return(data.frame())
 +
    if(length(test) == 1) out <- test[[1]]@output
 +
    if(length(test) == 2) out <- orbind(test[[1]], test[[2]])
 +
    if(length(test) == 3) out <- orbind(orbind(test[[1]], test[[2]]), test[[3]])
 +
   
 +
    # Find out the right marginals for the output
 +
    marginals <- character()
 +
    nonmarginals <- character()
 +
    for(i in 1:length(test)) {
 +
      marginals <- c(marginals, colnames(test[[i]]@output)[test[[i]]@marginal])
 +
      nonmarginals <- c(nonmarginals, colnames(test[[i]]@output)[!test[[i]]@marginal])
 +
    }
 +
   
 +
    test <- NULL
 +
    out <- out[!colnames(out) %in% c("populationSource", "populationResult")] # These are no longer needed.
 +
   
 +
    out <- Ovariable(output = out, marginal = colnames(out) %in% setdiff(marginals, nonmarginals))
 +
   
 +
    if("Exposcen" %in% colnames(out@output)) {
 +
      out <- out * Ovariable(
 +
        output = data.frame(Exposcen = c("BAU", "No exposure"), Result = c(1, -1)),
 +
        marginal = c(TRUE, FALSE)
 +
      )
 +
      out <- oapply(out, NULL, sum, "Exposcen")
 +
    }
 +
   
 +
    return(out)
 +
  }
 +
)
 +
 +
totcases2 <- EvalOutput(totcases2)
 +
unique(totcases2@output$Response)
 +
nrow(RR@output)
 +
 +
oprint(head(totcases2@output))
 +
ggplot(totcases2@output, aes(x = Response, weight = totcasesResult, fill = Gender))+geom_bar(position="dodge")
 
</rcode>
 
</rcode>
  

Revision as of 21:24, 14 March 2017



Scope

This assessment is part of the WP5 work in Goherr project. Purpose is to evaluate health benefits and risks caused of eating Baltic herring and salmon in four Baltic sea countries (Denmark, Estonia, Finland and Sweden). This assessment is currently on-going.

Question

What are the current population level health benefits and risks of eating Baltic herring and salmon in Finland, Estonia, Denmark and Sweden? How would the health effects change in the future, if consumption of Baltic herring and salmon changes due to actions caused by different management scenarios of Baltic sea fish stocks?

Intended use and users

Results of this assessment are used to inform policy makers about the health impacts of fish. Further, this assessment will be combined with the results of the other Goherr WPs to produce estimates of future health impacts of Baltic fish related to different policy options. Especially, results of this assessment will be used as input in the decision support model built in Goherr WP6.

Participants

  • National institute for health and welfare (THL)
  • Goherr project group

Boundaries

  • Four baltic sea countries (Denmark, Estonia, Finland, Sweden)
  • Current situation (fish use year 2016, pollutant levels in fish year 2010?)
  • Estimation for future (year 2020?)

Decisions and scenarios

Management scenarios developed in Goherr WP3 frames the following boundaries to the use and consumption of Baltic herring and salmon as human food. Effect of these scenarios to the dioxin levels and the human food use will be evalauted quantitatively and feed into the health benefit-risk model to assess the health effect changes.

  • Scenario 1: “Transformation to sustainability”
    • Hazardous substances, including dioxins, are gradually flushed out and the dioxin levels in Baltic herring are below or close to the maximum allowable level.
    • Fish stocks are allowed to recover to levels, which makes maximum sustainable yield possible and increases the total catches of wild caught fish. The catches of salmon by commercial fisheries has stabilized at low level, while the share of recreational catch increases slightly.
    • The use of the Baltic herring catch for food increases. A regional proactive management plan for the use of catch has increased the capacity of the fishing fleets to fish herring for food and through product development and joint marketing, have increased consumer demand for Baltic herring.
  • Scenario 2: “Business-as-usual”
    • The commercial catches of salmon continue to decrease. The demand for top predatory species, such as salmon and cod remains high, while the demand for herring decreased further as a result of demographic changes.
    • Most of the herring catch are used for fish meal and oil production in the region.
    • The use of Baltic herring from the southern parts of the Baltic Sea where the dioxin contents are not likely to exceed the maximum allowable level, are prioritised for human consumption. In the absence of the demand in many of the Baltic Sea countries, majority of the herring intended for direct human consumption are exported to Russia.
  • Scenario 3: “Inequality”
    • The nutrient and dioxins levels continue to decrease slowly.
    • The commercial catches of salmon have decreased further as the general attitudes favour recreational fishing, which has also resulted in decreased demand.
    • The herring catches have increased slightly, but the availability of herring suitable for human consumption remains low due to both, dioxin levels that remain above the maximum allowable limit in the northern Baltic Sea and the poor capacity to fish for food.
    • The use of the catch varies between countries. In Estonia, for example, where the whole catch has been traditionally used for human consumption, there is no significant change in this respect, but in Finland, Sweden and Denmark, herring fishing is predominantly feed directed.
  • Scenario 4: “Transformation to protectionism”
    • The level of hazardous substances also increases as emission sources are not adequately addressed.
    • Commercial salmon fisheries disappears almost completely from the Baltic Sea, although restocking keeps small scale fisheries going.
    • Many of the Baltic herring stocks are also fished above the maximum sustainable yield and total catches are declining.
    • Owing to the growing dioxin levels detected in herring, majority of the catch is used for aquaculture.

Timing

  • Model development during 2016 and 2017
  • First set of results in March 2017, draft publication in March 2018

Answer

This section will be updated as soon as preliminary results are available

Results

Conclusions

Rationale

Error creating thumbnail: Unable to save thumbnail to destination
Schematic picture of the health benefit-risk model for Baltic herring and salmon intake.

Stakeholders

  • Policy makers
    • Food safety authorities
    • Fisheries management
  • Researchers
    • Food safety
    • Health
  • NGO's
    • WWF
    • Active consumers
    • Marine Stewardship Council
  • Baltic sea fishers and producers?

Dependencies

Content of all variable pages below are preliminary and will be updated when this assessment proceeds.

Analyses

Indices

  • Country (Denmark, Estonia, Finland, Sweden)
  • Year (current, future)
  • Sex
  • Age (categories?)
  • Fish species (Baltic herring, Baltic salmon)
  • Health end-point (ICD-10 code?, name? something else? --# : This need to be matched for disability weight, duration of disease, background incidence and disease burden data, dose-responses --Arja (talk) 09:39, 22 September 2016 (UTC)
  • Compound (pollutant, fatty acid) --# : This needs to be matched with dose-responses --Arja (talk) 09:39, 22 September 2016 (UTC)

Calculations

This section will have the actual health benefit-risk model (schematically described in the above figure) written with R. The code will utilise all variables listed in the above Dependencies section. Model results are presented as tables and figures when those are available.

Bayes model for dioxin concentrations

  • Model run 28.2.2017 [1]
  • Model run 28.2.2017 with corrected survey model [2]
  • Model run 28.2.2017 with Mu estimates [3]
  • Model run 1.3.2017 [4]

+ Show code

Exposure model

+ Show code

Health impact model (Monte Carlo)

  • Model run 13.3.2017: a simple copy of op_fi:Silakan hyöty-riskiarvio [5]
  • Model run 13.3.2017 with showLocations function [6]
  • Model run 13.3.2017 produces totcases results but are not meaningful yet [7]
  • Model run 14.3.2017 with exposure graph [8]
  • Model run 14.3.2017 bugs not fixed [9]

+ Show code

Plot concentrations and survey

  • Requires codes Op_en7748/bayes and indirectly Op_en7748/preprocess.
  • Model run 1.3.2017 [10]

+ Show code

References


Keywords

See also

Goherr Research project 2015-2018: Integrated governance of Baltic herring and salmon stocks involving stakeholders
Error creating thumbnail: Unable to save thumbnail to destination
Goherr public website

Workpackages including task description and follow-up:
WP1 Management · WP2 Sociocultural use, value and goverrnance of Baltic salmon and herring · WP3 Scenarios and management objectives · WP4 Linking fish physiology to food production and bioaccumulation of dioxin · WP5 Linking the health of the Baltic Sea with health of humans: Dioxin · WP6 Building a decision support model for integrated governance · WP7 Dissemination

Other relevant pages in Opasnet: GOHERR assessment · Relevant literature

Relevant data: Exposure response functions of dioxins · Fish consumption in Sweden · POP concentrations in Baltic sea fish · Exposure response functions of Omega3 fatty acids

Relevant methods: Health impact assessment · OpasnetBaseUtils‎ · Modelling in Opasnet

Relevant assessments: Benefit-risk assessment of Baltic herring · Benefit-risk assessment on farmed salmon · Benefit-risk assessment of methyl mercury and omega-3 fatty acids in fish · Benefit-risk assessment of fish consumption for Beneris · Benefit-risk assessment of Baltic herring (in Finnish)

Error creating thumbnail: Unable to save thumbnail to destination
Error creating thumbnail: Unable to save thumbnail to destination

http://www.bonusportal.org/ http://www.bonusprojects.org/bonusprojects

Related files

Retrieved from "http://www.opasnet.org/testiwiki/index.php?title=Benefit-risk_assessment_of_Baltic_herring_and_salmon_intake&oldid=40160"