+ Näytä koodi- Piilota koodi
library(OpasnetUtils)
library(ggplot2)
N = 1
# Arvioinnin tulos
Tulos <- new("ovariable", name = "Tulos",
dependencies = data.frame(Name = c(
"Terveysvaikutukset",
"Altistuminen",
"Pitoisuus",
"tieliikennepäästöt",
"suorite"
), Ident = c(
"Op_fi3719/alustus", "Op_fi3719/alustus", "Op_fi3719/alustus", "Op_fi3192/alustus", ""
)),
formula = function(...) {
## Tämä on ihan kesken
return(out)
}
)
## hiukkasterveysvaikutus
hiukkasterveysvaikutus <- new(
"ovariable",
name = "hiukkasterveysvaikutus",
dependencies = data.frame(Name = c("hiukkasaltistus")),
formula = function(...) {
bg.mort <- 45182 / 5203826 # same values as used in PILTTI
erf <- 0.0097 # J. T. Tuomisto, A. Wilson, et al. Uncertainty in mortality response to airborne fine
# particulate matter... 2008. unit: m^3 /ug
out <- hiukkasaltistus * erf * bg.mort
return(out)
}
)
## hiukkasaltistus
hiukkasaltistus <- new(
"ovariable",
name = "hiukkasaltistus",
dependencies = data.frame(
Name = c("hiukkaspitoisuus"),
Ident = c("Op_fi3719/alustus")
),
formula = function(...) {
out <- GIS.Exposure(hiukkaspitoisuus, ...) # LO ja LA otetaan hiukkaspitoisuuden sarakkeista LObin ja LAbin
return(out)
}
)
## Pitoisuus
Pitoisuus <- new(
"ovariable",
name = "Pitoisuus",
dependencies = data.frame(
Name = c("tieliikennepäästöt")
),
formula = function(dependencies, ...) {
ComputeDependencies(dependencies, ...)
temp <- tieliikennepäästöt@output[tieliikennepäästöt@output$Saaste == "PM", ] # Valitaan vain PM-rivit.
temp <- as.data.frame(as.table(tapply(
temp$tieliikennepäästötResult,
temp[c("LA", "LO", "Vaihtoehto", "Saaste")], # HUOM! Probabilistiset päästöt eivät toimi koska Iter summataan.
sum
)))
temp <- temp[!is.na(temp$Freq), ] # Pudotetaan tyhjät rivit pois.
# Käydään päästö läpi rivi kerrallaan ja lasketaan pitoisuus.
out <- data.frame() # Tähän taulukkoon kerätään data
for(i in 1:nrow(temp)) {
Päästö <- temp$Freq[i]
LA <- as.numeric(as.character(temp$LA[i]))
LO <- as.numeric(as.character(temp$LO[i]))
# Altistuminen@output <- data.frame() # Nollataan, jotta malli laskee ne uusiksi uudelle päästölle.
# Pitoisuus@output <- data.frame()
# EvalOutput käyttää tilapäisiä, rivikohtaisia tietoja. Kunkin rivin tulos lisätään lopputulokseen.
out <- rbind(
out,
merge(
temp[i, ],
GIS.Concentration.matrix(Päästö, LO, LA, ...)@output, by = NULL
)
)
}
return(out)
}
)
################# tieliikennepäästöt: funktio tieliikennepäästön laskemiseen
## suorite = ajoneuvojen kulkemat ajokilometrit. Junien osalta ilmoitetaan tonnikilometrit.
tieliikennepäästöt <- new("ovariable",
name = "tieliikennepäästöt",
dependencies = data.frame(Name = c("suorite")),
formula = function(dependencies, ...) {
ComputeDependencies(dependencies, ...)
päästökerroin <- new("ovariable", name = "päästökerroin", ddata = "Op_fi3192") # Haetaan päästökerrointiedot
päästökerroin <- EvalOutput(päästökerroin, N = N, ...)
out <- suorite * päästökerroin # Varsinainen laskentakaava
return(out)
}
)
# suorite
suorite <- new("ovariable",
name = "suorite",
data = {temp <- tidy(opbase.data("Op_fi3357"))
# Luodaan tilapäiset ovariablet, jotta mahdollinen probabilistisuus menee oikein.
lm <- new("ovariable", name = "lm", data = {
temp2 <- temp[colnames(temp) != "Pituus"]
colnames(temp2)[colnames(temp2) == "Liikennemäärä"] <- "Result"
temp2
})
pi <- new("ovariable", name = "pi", data = {
temp3 <- temp[colnames(temp) != "Liikennemäärä"]
colnames(temp3)[colnames(temp3) == "Pituus"] <- "Result"
temp3
})
data <- EvalOutput(lm, N = N) * EvalOutput(pi, N = N) * 365 * 1E-6 # Muutetaan d -> a ja km -> Gm
data@output[!colnames(data@output) %in% c("lmSource", "lmResult", "piSource", "piResult", "Description", "Unit")]
}
)
objects.store(Tulos, hiukkasterveysvaikutus, hiukkasaltistus, Pitoisuus, tieliikennepäästöt, suorite)
cat("Tallennettu ovariablet Tulos, Terveysvaikutukset, Altistuminen, Pitoisuus, tieliikennepäästöt, suorite. \n")
| |
