Ero sivun ”Väestön kohdekohtainen ympäristöperäisen haitta-ainealtistumisen arviointi” versioiden välillä
Siirry navigaatioon
Siirry hakuun
(edistymisluokitus lisätty) |
pEi muokkausyhteenvetoa |
||
Rivi 3: | Rivi 3: | ||
{{metodi|moderator=Virpi Kollanus}} | {{metodi|moderator=Virpi Kollanus}} | ||
== | <rcode graphics="1" label="Arvioinnin tulos" | ||
variables="name:altiste|description:Mitä altistetta tarkastellaan?|type:selection|options: | |||
'Arseeni';Arseeni; | |||
'Elohopea';Elohopea; | |||
'Kadmium';Kadmium; | |||
'Koboltti';Koboltti; | |||
'Kromi (3+)';Kromi (3+); | |||
'Kupari';Kupari; | |||
'Lyijy';Lyijy; | |||
'Lyijy';Lyijy; | |||
'Nikkeli';Nikkeli; | |||
'Sinkki';Sinkki; | |||
'Vanadiini';Vanadiini| | |||
default:'Arseeni' | |||
" | |||
> | |||
library(OpasnetUtils) | |||
library(ggplot2) | |||
N <- 1 | |||
pitoisuusviitearvo <- rbind( | |||
tidy(opbase.data("Op_fi3373.maapera"), objname = "pitoisuusviitearvo"), | |||
tidy(opbase.data("Op_fi3373.talousvesi"), objname = "pitoisuusviitearvo") | |||
) | |||
pitoisuusviitearvo <- EvalOutput(Ovariable(name = "pitoisuusviitearvo", data = pitoisuusviitearvo)) | |||
altistusviitearvo <- tidy(opbase.data("Op_fi3373.haitta-aine"), objname = "altistusviitearvo") | |||
altistusviitearvo <- EvalOutput(Ovariable(name = "altistusviitearvo", data = altistusviitearvo)) | |||
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 <- 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(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(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 <- Ovariable(name = "pitoisuus", data = pitoisuus) | |||
} | |||
pitoisuus <- EvalOutput(pitoisuus, N = N) | |||
cat("Altistumisen arvioinnin perusteena käytetyt ympäristön haitta-ainepitoisuudet .\n") | |||
oprint(summary(pitoisuus)) | |||
cat("Muiden altistumisen arvioinnissa käytettyjen muuttujien arvot.\n") | |||
temp <- opbase.data("Op_fi2814") | |||
oprint(temp) | |||
cat("Ympäristön laadun arvioinnissa käytetyt haitta-ainepitoisuuksien terveysperusteiset viitearvot.\n") | |||
oprint(summary(pitoisuusviitearvo)) | |||
cat("Kroonisesta haitta-ainealtistumisesta aiheutuvan terveysriskin arvioinnissa käytetyt toksisuuden viitearvot.\n") | |||
oprint(summary(altistusviitearvo)) | |||
pitoisuus <- pitoisuus * params | |||
# Calculate exposures with respective functions. | |||
## Create an ovariable that collects all results. | |||
out <- 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", "Altistus", "Result")] | |||
cat("Altistus kiinnostuksen kohteena olevalle altisteelle altistusreiteittäin (µg/kg/vrk).\n") | |||
oprint(out@output[out@output$Altiste == altiste, ], digits=3) | |||
# 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")], | |||
sum | |||
))) | |||
colnames(kokonaisaltistus@output) <- gsub("Freq", "Result", colnames(kokonaisaltistus@output)) | |||
terveysvertailu <- kokonaisaltistus / altistusviitearvo | |||
terveysvertailu@output <- terveysvertailu@output[ , c("Altiste", "Ikä", "Altistumistaso", "altistusviitearvoKuvaus", "Result")] | |||
terveysvertailu@output <- reshape( | |||
terveysvertailu@output, | |||
timevar = "Ikä", | |||
idvar = c("Altiste", "Altistumistaso"), | |||
v.names = "Result", | |||
direction = "wide" | |||
) | |||
colnames(terveysvertailu@output) <- gsub("Result.", "", colnames(terveysvertailu@output)) | |||
# Lasketaan kokonaisaltistuksen keskiarvo | |||
kokonaisaltistus@output <- as.data.frame(as.table(tapply( | |||
kokonaisaltistus@output$Result, | |||
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)) | |||
cat("Altistumisen arvioinnin tulokset. \n Keskimääräinen päivittäinen haitta-aineen saanti (µg/kg/vrk).\n") | |||
oprint(kokonaisaltistus@output, digits = 4) | |||
#summary(kokonaisaltistus) | |||
cat("Haitta-aineen pitoisuus ympäristössä suhteutettuna terveysperusteiseen viitearvoon.\n") | |||
temp <- pitoisuus / pitoisuusviitearvo | |||
temp@output <- temp@output[ , c("Matriisi", "Altiste", "Altistumistaso", "Altistus", "pitoisuusviitearvoKuvaus", "Result")] | |||
oprint(temp@output) | |||
#summary(pitoisuus/pitoisuusviitearvo) | |||
cat("Kroonisesta ympäristöperäisestä haitta-ainealtistumisesta aiheutuvan terveysriskin karakterisointi. \n") | |||
oprint(terveysvertailu@output) | |||
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)) | |||
</rcode> | </rcode> |
Versio 12. maaliskuuta 2013 kello 08.21
Edistymisluokitus |
---|
Opasnetissa lukuisat sivut ovat työn alla eri vaiheissa. Niiden tietosisältöön pitää siis suhtautua harkiten. Tämän sivun sisällön edistyminen on arvioitu:
|
Moderaattori:Virpi Kollanus (katso kaikki)
Sivun edistymistä ei ole arvioitu. Arvostuksen määrää ei ole arvioitu (ks. peer review). |
Lisää dataa
|