+ Näytä koodi- Piilota koodi
library(OpasnetUtils)
library(xtable)
library(ggplot2)
N <- 1
tf <- function(
condition,
data = tidy(opbase.data("Op_fi2814"), direction = "long"),
col.condition = "Lyhenne",
col.common = "Ikä",
resultcol = "Result", ...
) {
########################## tf is a function that takes one large table, finds matching rows and
#### produces a standard-format vector that can be operated with easily. Parameters:
# condition = a vector with conditions for each condition column. The length must be ncol(col.condition).
############ External parameters (these must be defined as objects before the function is run;
##### they are not given in the function but they are used by it):
# data = a data frame that contains the data
# col.condition = vector with names of columns that contain the indices that must match in the data
# col.common = vector with names of columns that are used as indices in calculations.
# resultcol = the column that contains the actual values.
# Take the part of data that fits the condition. Drop all columns but col.common and resultcol.
out <- new("ovariable",
# ovariable cannot have a name because several ovariables are created and merged.
data = data[data[col.condition] == condition, c(col.common, resultcol)]
)
out <- EvalOutput(out, N = N)
out@output <- out@output[ , colnames(out@output) != "Source"]
return(out)
}
#Chronic.environmental.exposure <- function(pitoisuus, ...) {
####################Funktio väestön ympäristöperäisen haitta-ainealtistumisen määrittelyyn
######## Saanti lasketaan yksikössä µg/kg/vrk kun ympäristön haitta-ainepitoisuudet on ilmoitettu yksiköissä µg/m3 (ilma),
######## mg/l (vesi) sekä mg/kg (kiinteät väliaineet)
######## Haitta-aineen taustasaanti tulee ilmoittaa muodossa µg/kg/vrk
######## Parametri: pitoisuus on data.frame, jossa täytyy olla sarake Result, joka sisältää pitoisuuden ja Altiste, joka sisältää altistavan yhdisteen nimen.
########## Pharmacokinetic parameters
temp <- tidy(opbase.data("Op_fi3378.vesi"), objname = "Kp")
temp <- temp[ , c("Altiste", "KpResult")]
Kp <- EvalOutput(new("ovariable", name = "Kp", data = temp), N = N)
temp <- tidy(opbase.data("Op_fi3378.maapera"), objname = "Abs.skin.soil")
temp <- temp[ , !colnames(temp) %in% c("Obs", "Abs.skin.soilYksikkö", "Abs.skin.soilKuvaus")]
Abs.skin.soil <- EvalOutput(new("ovariable", name = "Abs.skin.soil", data = temp), N = N)
Skin.sa <- (4 * tf("Bw") + 7) / (tf("Bw") + 90) * 10000 #Lasketaan ihon kokonaispinta-ala
F1 <- function(pitoisuus, rate, fraction) { # Ulkoilma-altistuminen
out <- pitoisuus * (24 - tf(fraction) / 24) * tf(rate) / (tf("Bw") * tf("At"))
return(out)
}
F2 <- function(pitoisuus, rate, fraction) { # Sisäilma-altistuminen
out <- pitoisuus * tf(fraction) / 24 * tf(rate) / (tf("Bw") * tf("At"))
return(out)
}
F3 <- function(pitoisuus, rate, fraction) { # Altistusfrekvenssiin perustuva
out <- pitoisuus * tf(rate) * tf(fraction) / (tf("Bw") * tf("At"))
return(out)
}
F4 <- function(pitoisuus, rate, fraction) { # Altistumisen osuuteen perustuva
out <- pitoisuus * 1000 * tf(rate) * tf(fraction) / tf("Bw")
return(out)
}
F5 <- function(pitoisuus, rate, fraction) { # Ihoaltistuminen maaperästä
out <- pitoisuus * tf("Soil.ad.skin") * 0.001 * Skin.sa * tf(fraction) *
Abs.skin.soil / (tf("Bw") * tf("At")) * tf(rate)
out@output <- out@output[ , !colnames(out@output) %in% c("Abs.skin.soilResult", "Abs.skin.soilSource")]
return(out)
}
F6 <- function(pitoisuus, rate, fraction) { # Pesuvesi
out <- pitoisuus * Kp * tf(rate) * tf("Ed.bw") * Skin.sa * tf(fraction) /
(tf("Bw") * tf("At"))
out@output <- out@output[ , !colnames(out@output) %in% c("KpResult", "KpSource")]
return(out)
}
F7 <- function(pitoisuus, rate, fraction) { # Pintavesi
out <- pitoisuus * Kp * tf(rate) * tf("Ed.sw") * Skin.sa * tf(fraction) /
(tf("Bw") * tf("At"))
out@output <- out@output[ , !colnames(out@output) %in% c("KpResult", "KpSource")]
return(out)
}
# Get parameters for exposure functions and combine those with concentration data.
# [[Väestön kohdekohtainen ympäristöperäisen haitta-ainealtistumisen ja terveysriskin arviointi]]
temp <- opbase.data("Op_fi2814.funktioparametrit")
temp$Result <- 1
params <- new("ovariable", name = "params", output = temp[ , colnames(temp) != "Obs"])
pitoisuus <- tidy(opbase.data("Op_fi3372"), objname = "pitoisuus")
pitoisuus <- pitoisuus[ , colnames(pitoisuus) != "Obs"]
# Make pitoisuus an ovariable if it isn't yet (assuming that then it is a data.frame).
if(class(pitoisuus) != "ovariable") {
pitoisuus <- new("ovariable", name = "pitoisuus", data = pitoisuus)
}
pitoisuus <- EvalOutput(pitoisuus, N = N)
pitoisuus <- pitoisuus * params
# Calculate exposures with respective functions.
## Create an ovariable that collects all results.
out <- new("ovariable", name = "exposure")
equations <- unique(pitoisuus@output[c("Funktio", "Nopeus", "Osuus")])
for(i in 1:nrow(equations)) {
temp2 <- pitoisuus
temp2@output <- temp2@output[
temp2@output$Funktio == equations$Funktio[i] &
temp2@output$Nopeus == equations$Nopeus[i] &
temp2@output$Osuus == equations$Osuus[i]
, ]
temp2 <- get(as.character(equations$Funktio[i]))(
temp2,
as.character(equations$Nopeus[i]),
as.character(equations$Osuus[i])
)
out@output <- rbind(out@output, temp2@output)
}
# return(out)
#}
# Poistetaan turhat sarakkeet
out@output <- out@output[ , c("Ikä","Altiste", "Matriisi", "Altistumistaso", "Iter", "Altistus", "Result")]
print(xtable(out@output[out@output$Altiste == altiste, ], digits=3), type = 'html')
# Lasketaan elinikäinen altistus
aikuisaltistus <- out
aikuisaltistus@output <- aikuisaltistus@output[aikuisaltistus@output$Ikä == "Aikuinen", ]
aikuisaltistus@output$Ikä <- "Elinikäinen"
lapsialtistus <- out
lapsialtistus@output <- lapsialtistus@output[lapsialtistus@output$Ikä == "Lapsi", ]
lapsialtistus@output$Ikä <- "Elinikäinen"
kokonaisaltistus <- out
kokonaisaltistus@output <- rbind(kokonaisaltistus@output, ((lapsialtistus * 6 + aikuisaltistus * 64) / 70)@output )
# Lasketaan kokonaisaltistus.
kokonaisaltistus@output <- as.data.frame(as.table(tapply(
kokonaisaltistus@output$Result,
kokonaisaltistus@output[c("Ikä", "Altiste", "Altistumistaso", "Iter")],
sum
)))
# Lasketaan kokonaisaltistuksen keskiarvo
kokonaisaltistus@output <- as.data.frame(as.table(tapply(
kokonaisaltistus@output$Freq,
kokonaisaltistus@output[c("Ikä", "Altiste", "Altistumistaso")],
mean
)))
# Käännetään ikä-indeksi leveään muotoon.
kokonaisaltistus@output <- reshape(
kokonaisaltistus@output,
timevar = "Ikä",
idvar = c("Altiste", "Altistumistaso"),
direction = "wide"
)
colnames(kokonaisaltistus@output) <- gsub("Freq.", "", colnames(kokonaisaltistus@output))
print(xtable(kokonaisaltistus@output, digits = 4), type = 'html')
ggplot(out@output[out@output$Altiste == altiste, ], aes(x = Matriisi, y = Result, colour = Ikä)) +
geom_point(size = 5) +
theme_grey(base_size = 24) +
labs(
title = altiste,
y = "Altistus (µg /kg /d)"
)
#Chronic.environmental.exposure(data.frame(Result = 1))
| |
