+ Show code- Hide code # This is code Op_en3104/bayes on page [[EU-kalat]]
library(OpasnetUtils)
library(reshape2)
library(rjags) # JAGS
library(ggplot2)
library(MASS) # mvrnorm
library(car) # scatterplotMatrix
objects.latest("Op_en3104", code_name = "preprocess") # [[EU-kalat]]
# Hierarchical Bayes model.
# PCDD/F concentrations in fish.
# It uses the sum of PCDD/F (Pcdsum) as the total concentration of dioxin in fish.
# Cong_j is the fraction of a congener from pcdsum.
# pcdsum is log-normally distributed. cong_j follows Dirichlet distribution.
# pcdsum depends on age of fish, fish species and catchment area, but we only have species now so other variables are omitted.
# cong_j depends on fish species.
if(FALSE) { # Multicongener model NOT updated to reflect new names: eu -> euMain
conl <- as.character(unique(eu@output$Congener))
fisl <- sort(as.character(unique(eu@output$Fish)))
C <- length(conl)
Fi <- length(fisl)
N <- 1000
conl
fisl
fishsamples <- reshape(
eu@output,
v.names = "euResult",
idvar = "THLcode",
timevar = "Congener",
drop = c("Matrix", "euSource"),
direction = "wide"
)
# Find the level of quantification for dinterval function
LOQ <- unlist(lapply(fishsamples[3:ncol(fishsamples)], FUN = function(x) min(x[x!=0])))
names(LOQ) <- conl
cong <- data.matrix(fishsamples[3:ncol(fishsamples)])
cong <- sapply(1:length(LOQ), FUN = function(x) ifelse(cong[,x]==0, 0.5*LOQ[x], cong[,x]))
mod <- textConnection("
model{
for(i in 1:S) { # s = fish sample
# below.LOQ[i,j] ~ dinterval(-cong[i,j], -LOQ[j])
cong[i,1:C] ~ dmnorm(mu[fis[i],], Omega[fis[i],,])
}
for(i in 1:Fi) { # Fi = fish species
for(j in 1:C) {
mu[i,j] ~ dnorm(mu1[j], tau1[j])
}
Omega[i,1:C,1:C] ~ dwish(Omega0[1:C,1:C],S)
pred[i,1:C] ~ dmnorm(mu[i,], Omega[i,,]) # Model prediction
}
for(i in 1:C) { # C = Compound
mu1[i] ~ dnorm(0, 0.0001)
tau1[i] ~ dunif(0,10000)
pred1[i] ~ dnorm(mu1[i], tau1[i])
}
Omega1[1:C,1:C] ~ dwish(Omega0[1:C,1:C],S)
}
")
jags <- jags.model(
mod,
data = list(
S = nrow(fishsamples),
C = C,
Fi = Fi,
cong = log(cong),
# LOQ = LOQ,
# below.LOQ = is.na(cong)*1,
fis = match(fishsamples$Fish, fisl),
Omega0 = diag(C)/100000
),
n.chains = 4,
n.adapt = 100
)
} # if(FALSE)
conl <- c("TEQdx", "TEQpcb")
fisl <- sort(as.character(unique(euMain$Fish))) # Take only the main fish species
C <- length(conl)
Fi <- length(fisl)
N <- 1000
conl
fisl
fishsamples <- euAll@output[euAll$Compound %in% conl , ]
fishsamples <- reshape(
fishsamples,
v.names = "euAllResult",
idvar = "THLcode",
timevar = "Compound",
drop = c("Matrix", "euRawSource"),
direction = "wide"
)
# Find the level of quantification for dinterval function
LOQ <- unlist(lapply(fishsamples[3:ncol(fishsamples)], FUN = function(x) min(x[x!=0])))
names(LOQ) <- conl
cong <- data.matrix(fishsamples[3:ncol(fishsamples)])
cong <- sapply(1:length(LOQ), FUN = function(x) ifelse(cong[,x]==0, 0.5*LOQ[x], cong[,x]))
mod <- textConnection("
model{
for(i in 1:S) { # s = fish sample
# below.LOQ[i,j] ~ dinterval(-cong[i,j], -LOQ[j])
cong[i,1:C] ~ dmnorm(mu[fis[i],], Omega[fis[i],,])
}
for(i in 1:Fi) { # Fi = fish species
for(j in 1:C) {
mu[i,j] ~ dnorm(mu1[j], tau1[j])
}
Omega[i,1:C,1:C] ~ dwish(Omega0[1:C,1:C],S)
pred[i,1:C] ~ dmnorm(mu[i,], Omega[i,,]) # Model prediction
}
for(i in 1:C) { # C = Compound
mu1[i] ~ dnorm(0, 0.0001)
tau1[i] ~ dunif(0,10000)
pred1[i] ~ dnorm(mu1[i], tau1[i])
}
Omega1[1:C,1:C] ~ dwish(Omega0[1:C,1:C],S)
}
")
jags <- jags.model(
mod,
data = list(
S = nrow(fishsamples),
C = C,
Fi = Fi,
cong = log(cong),
# LOQ = LOQ,
# below.LOQ = is.na(cong)*1,
fis = match(fishsamples$Fish, fisl),
Omega0 = diag(C)/100000
),
n.chains = 4,
n.adapt = 100
)
update(jags, 100)
samps.j <- jags.samples(
jags,
c('mu', 'Omega', 'pred', 'mu1', 'Omega1', 'tau1', 'pred1'),
N
)
dimnames(samps.j$mu) <- list(Fish = fisl, Compound = conl, Iter = 1:N, Chain = 1:4)
dimnames(samps.j$mu1) <- list(Compound = conl, Iter = 1:N, Chain = 1:4)
dimnames(samps.j$pred) <- list(Fish = fisl, Compound = conl, Iter = 1:N, Chain = 1:4)
dimnames(samps.j$mu1) <- list(Compound = conl, Iter = 1:N, Chain = 1:4)
dimnames(samps.j$tau1) <- list(Compound = conl, Iter = 1:N, Chain = 1:4)
dimnames(samps.j$pred1) <- list(Compound = conl, Iter = 1:N, Chain = 1:4)
dimnames(samps.j$Omega) <- list(Fish = fisl, Compound = conl, Compound2 = conl, Iter=1:N, Chain=1:4)
dimnames(samps.j$Omega1) <- list(Compound = conl, Compound2 = conl, Iter=1:N, Chain=1:4)
##### conc.param contains expected values of the distribution parameters from the model
conc.param <- list(
mu = apply(samps.j$mu[,,,1], MARGIN = 1:2, FUN = mean),
Omega = apply(samps.j$Omega[,,,,1], MARGIN = 1:3, FUN = mean),
pred.mean = apply(samps.j$pred[,,,1], MARGIN = 1:2, FUN = mean),
pred.sd = apply(samps.j$pred[,,,1], MARGIN = 1:2, FUN = sd),
mu1 = apply(samps.j$mu1[,,1], MARGIN = 1, FUN = mean),
tau1 = apply(samps.j$tau1[,,1], MARGIN = 1, FUN = mean),
pred1.mean = apply(samps.j$pred1[,,1], MARGIN = 1, FUN = mean),
pred1.sd = apply(samps.j$pred1[,,1], MARGIN = 1, FUN = sd)
)
objects.store(conc.param, samps.j)
cat("Lists conc.params and samps.j stored.\n")
# Predictions for all congeners of fish1 (Baltic herring)
scatterplotMatrix(t(samps.j$pred[1,,,1]))
# Means for all congeners of the generic fish
scatterplotMatrix(t(samps.j$mu1[,,1]))
# Prediction for all congeners of the generic fish
scatterplotMatrix(t(samps.j$pred1[,,1]))
# Predictions for all fish species for TCDD
scatterplotMatrix(t(samps.j$pred[,1,,1]))
# Predictions for pike for omegas and PeCDD
scatterplotMatrix(t(samps.j$Omega[6,2,,,1]))
ggplot(melt(exp(samps.j$pred[,,,1])), aes(x=value, colour=Compound))+geom_density()+
facet_wrap( ~ Fish,scales = "free_y")+scale_x_log10()
ggplot(eu@output, aes(x = euResult, colour=Congener))+geom_density()+
facet_wrap( ~ Fish, scales = "free_y")+scale_x_log10()
#stat_ellipse()
coda.j <- coda.samples(
jags,
c('mu', 'pred', 'omega1', 'pred1'),
N
)
plot(coda.j)
| |