|
|
Rivi 76: |
Rivi 76: |
| " | | " |
| graphics = "1" | | graphics = "1" |
| | include="page:OpasnetUtils/Ograph|name:answer" |
| > | | > |
|
| |
|
Rivi 88: |
Rivi 89: |
| library(raster) | | library(raster) |
|
| |
|
| Fetch2 <- function(dependencies, evaluate = FALSE, indent = 0, verbose = TRUE, ...) { | | #Fetch2 <- function(dependencies, evaluate = FALSE, indent = 0, verbose = TRUE, ...) { |
| if (nrow(dependencies) > 0) {
| | # if (nrow(dependencies) > 0) { |
| for (i in 1:nrow(dependencies)) {
| | # for (i in 1:nrow(dependencies)) { |
| if(!exists(as.character(dependencies$Name[i]))) {
| | # if(!exists(as.character(dependencies$Name[i]))) { |
| testkey <- if (is.null(dependencies$Key[i])) TRUE else is.na(dependencies$Key[i]) | dependencies$Key[i] == ""
| | # testkey <- if (is.null(dependencies$Key[i])) TRUE else is.na(dependencies$Key[i]) | dependencies$Key[i] == "" |
| testid <- if (is.null(dependencies$Ident[i])) TRUE else is.na(dependencies$Ident[i]) | dependencies$Ident[i] == ""
| | # testid <- if (is.null(dependencies$Ident[i])) TRUE else is.na(dependencies$Ident[i]) | dependencies$Ident[i] == "" |
| if (testkey & testid) {
| | # if (testkey & testid) { |
| stop(paste("No key nor ident given for dependent variable: ", dependencies$Name[i], "!", sep = ""))
| | # stop(paste("No key nor ident given for dependent variable: ", dependencies$Name[i], "!", sep = "")) |
| }
| | # } |
| if (!testkey) {
| | # if (!testkey) { |
| objects.get(dependencies$Key[i]) # Key is the R-tools session identifier (shown at the end of the url)
| | # objects.get(dependencies$Key[i]) # Key is the R-tools session identifier (shown at the end of the url) |
| }
| | # } |
| if (testkey & !testid) {
| | # if (testkey & !testid) { |
| ident <- strsplit(as.character(dependencies$Ident[i]), "/")[[1]] # Ident should be in format <page_id>/<code_name>
| | # ident <- strsplit(as.character(dependencies$Ident[i]), "/")[[1]] # Ident should be in format <page_id>/<code_name> |
| objects.latest(ident[1], ident[2])
| | # objects.latest(ident[1], ident[2]) |
| }
| | # } |
| if (evaluate) assign(
| | # if (evaluate) assign( |
| as.character(dependencies$Name[i]),
| | # as.character(dependencies$Name[i]), |
| EvalOutput(get(as.character(dependencies$Name[i])), ...),
| | # EvalOutput(get(as.character(dependencies$Name[i])), ...), |
| envir = .GlobalEnv
| | # envir = .GlobalEnv |
| )
| | # ) |
| if (verbose) cat("\n", rep("-", indent), as.character(dependencies$Name[i]), "fetched successfully!\n")
| | # if (verbose) cat("\n", rep("-", indent), as.character(dependencies$Name[i]), "fetched successfully!\n") |
| }
| | # } |
| }
| | # } |
| }
| | # } |
| } # no need to return anything since variables are written in global memory by objects.get | | #} # no need to return anything since variables are written in global memory by objects.get |
|
| |
|
|
| |
|
Rivi 129: |
Rivi 130: |
| )), | | )), |
| formula = function(dependencies, ...) { | | formula = function(dependencies, ...) { |
|
| |
| #Perustetaan muuttujia joita kohta etsitään.
| |
|
| |
|
| ComputeDependencies(dependencies, ...) | | ComputeDependencies(dependencies, ...) |
Rivi 140: |
Rivi 139: |
| temp <- as.data.frame(as.table(tapply( | | temp <- as.data.frame(as.table(tapply( |
| temp$tieliikennepäästötResult, | | temp$tieliikennepäästötResult, |
| temp[c("LA", "LO", "Vaihtoehto", "Saaste", "PäästöSource")], | | temp[c("LA", "LO", "Vaihtoehto", "Saaste")], # HUOM! Probabilistiset päästöt eivät toimi koska Iter summataan. |
| sum | | sum |
| ))) | | ))) |
|
| |
|
| temp <- temp[!is.na(temp$Freq), ] # Pudotetaan tyhjät rivit pois. | | temp <- temp[!is.na(temp$Freq), ] # Pudotetaan tyhjät rivit pois. |
| | | oprint(temp) |
| # Käydään päästö läpi rivi kerrallaan ja lasketaan pitoisuus, altistuminen ja terveysvaikutus. | | # Käydään päästö läpi rivi kerrallaan ja lasketaan pitoisuus, altistuminen ja terveysvaikutus. |
|
| |
|
| out <- data.frame() # Tähän taulukkoon kerätään data | | out <- data.frame() # Tähän taulukkoon kerätään data |
| print(temp)
| | |
| for(i in 1:nrow(temp)) { | | for(i in 1:nrow(temp)) { |
|
| |
|
Rivi 155: |
Rivi 154: |
| LA <- as.numeric(as.character(temp$LA[i])) | | LA <- as.numeric(as.character(temp$LA[i])) |
| LO <- as.numeric(as.character(temp$LO[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. | | # EvalOutput käyttää tilapäisiä, rivikohtaisia tietoja. Kunkin rivin tulos lisätään lopputulokseen. |
Rivi 165: |
Rivi 166: |
| ) | | ) |
| ) | | ) |
|
| |
| # Nollataan Altistuminen ja Pitoisuus, jotta malli laskee ne uusiksi uudelle päästölle.
| |
|
| |
| Altistuminen@output <- data.frame()
| |
| Pitoisuus@output <- data.frame()
| |
| } | | } |
| return(out) | | return(out) |
Rivi 203: |
Rivi 199: |
| name = "Altistuminen", | | name = "Altistuminen", |
| dependencies = data.frame( | | dependencies = data.frame( |
| Name = c("Pitoisuus", "LO", "LA"), | | Name = c("Pitoisuus", "LO", "LA") |
| Ident = "Op_fi3192/alustus"
| |
| ), | | ), |
| formula = function(dependencies, ...) { | | formula = function(dependencies, ...) { |
Rivi 215: |
Rivi 210: |
| ) | | ) |
|
| |
|
| ## Pitoisuudet | | ## Pitoisuus |
|
| |
|
| Pitoisuus <- new( | | Pitoisuus <- new( |
Rivi 232: |
Rivi 227: |
| ) | | ) |
|
| |
|
| Päästö <- 0 | | Päästö <- 1 |
| LO <- 0
| | LA <- 61.477491 |
| LA <- 0
| | LO <- 21.787756 |
|
| |
|
| ################# tieliikennepäästöt: funktio tieliikennepäästön laskemiseen | | ################# tieliikennepäästöt: funktio tieliikennepäästön laskemiseen |
Rivi 280: |
Rivi 275: |
| ) | | ) |
|
| |
|
| # suorite <- EvalOutput(suorite)
| | Tulos <- EvalOutput(Tulos) |
|
| |
|
| | if(intermediates) { |
| | cat("Liikennesuorite.\n") |
| | oprint(suorite@data) |
|
| |
|
| oprint(Altistuminen)
| | cat("Kokonaispienhiukkaspäästöt eri pisteistä.\n") |
| #Altistuminen
| | oprint(tieliikennepäästöt) |
| #Pitoisuus
| |
| #tieliikennepäästöt
| |
| #suorite
| |
| #Tulos <- EvalOutput(Tulos)
| |
| #oprint(Tulos)
| |
|
| |
|
| if(intermediates) {cat("Liikennesuorite.\n"); oprint(suorite@data)
| | cat("Yksityiskohtaiset päästötiedot.\n") |
| | oprint(temp) |
|
| |
|
| cat("Kokonaispienhiukkaspäästöt eri pisteistä.\n") | | cat("Yksityiskohtainen lopputulos.\n") |
| print(xtable(Päästö.temp@output), type = 'html')
| | oprint(Tulos) |
| | } |
|
| |
|
| if(intermediates) {cat("Yksityiskohtaiset päästötiedot.\n"); oprint(temp)} | | #if(N > 10) {ggplot(temp, aes(x = Freq, fill = Vaihtoehto)) + geom_density(alpha = 0.2)} |
|
| |
|
| if(intermediates) {cat("Yksityiskohtainen lopputulos.\n"); print(xtable(Lopputulos[Lopputulos$Iter == 1, ]), type = 'html')}
| | cat("Pienhiukkasten aiheuttamia ylimääräisiä kuolemantapauksia vuodessa.\n") |
|
| |
|
| temp <- as.data.frame(as.table(tapply(Lopputulos$TerveysvaikutuksetResult, Lopputulos[c("Vaihtoehto", "Iter")], sum)))
| |
|
| |
|
| if(N > 10) {ggplot(temp, aes(x = Freq, fill = Vaihtoehto)) + geom_density(alpha = 0.2)}
| | ggplot(Tulos@output, aes(x = TerveysvaikutuksetResult, fill = Vaihtoehto)) + geom_density() |
| | |
| cat("Pienhiukkasten aiheuttamia ylimääräisiä kuolemantapauksia vuodessa.\n")
| |
|
| |
|
| print(xtable(as.data.frame(as.table(tapply(temp$Freq, temp[c("Vaihtoehto")], mean)))), type = 'html')
| | oprint(Tulos@output[Tulos@output$Iter == 1, ]) |
|
| |
|
| ################################# | | ################################# |
Kysymys
Miten terveysvaikutusarviointi pitäisi huomioida kaupunkitason päätöksenteossa Porissa? Mitä kehityshankkeita on meneillään?
Vastaus
Perustelut
Riippuvuudet
Tärkeitä henkilöitä Porissa:
- Päivi Kolehmainen, kaupunginvaltuutettu
- Timo Aro, kehittämispäällikkö
- Sirpa Kynäslahti, hyvinvointikoordinaattori
Data
Laskenta
Matkakeskuksen pienhiukkaspäästöt
<googlemap version="0.9" lat="61.4833" lon="21.800051" type="map" zoom="14">
(L) 61.481462, 21.798688, Oy Matkahuolto Ab
Itsenäisyydenkatu 44
Pori,
(R) 61.477491, 21.787756, Rautatieasema
Pori
Finland
,
</googlemap>
Kysymys
Kuinka suuret ovat pienhiukkaspäästöt Porissa matkakeskukseen liittyen, ja mitä terveysvaikutuksia niillä on?
Vastaus
Ylimääräisiä kuolemantapauksia vuodessa
Vaihtoehto |
Tulos
|
Matkakeskus keskustassa |
|
Matkakeskus rautatieasemalla |
|
Perustelut
⇤#: Käytetty leviämis- ja altistumalli on tarkkuudeltaan vain yksi kilometri. Kilometriresoluutio on riittämätön. Malli antaa vain karkeita arvioita ja luultavasti vähättelee vaihtoehtojen eroja ja kokonaisvaikutuksia. --Jouni Tuomisto 25. lokakuuta 2012 kello 00.24 (EEST)
- ⇤#: Totta on, että malli vähättelee muutaman sadan metrin säteellä päästölähteestä tapahtuvaa altistumista. Kuitenkin virheen suunta on tiedossa, ja se vähättelee terveyshaittoja tilanteissa, jotka sisältävät enemmän liikennettä tiheämmin asutuilla alueilla. --Jouni Tuomisto 13. maaliskuuta 2013 kello 04.27 (EET)
Laskenta
HUOM! Tällä hetkellä malli laskee ainoastaan pienhiukkaspäästön leviämisen 10-15 km:n säteellä olevaan väestöön. Mallia päivitetään jatkuvasti.
+ Näytä koodi- Piilota koodi
library(OpasnetUtils)
library(ggplot2)
library(xtable)
library(OpasnetUtilsExt)
library(rgdal)
library(maptools)
library(RColorBrewer)
library(classInt)
library(raster)
#Fetch2 <- function(dependencies, evaluate = FALSE, indent = 0, verbose = TRUE, ...) {
# if (nrow(dependencies) > 0) {
# for (i in 1:nrow(dependencies)) {
# if(!exists(as.character(dependencies$Name[i]))) {
# testkey <- if (is.null(dependencies$Key[i])) TRUE else is.na(dependencies$Key[i]) | dependencies$Key[i] == ""
# testid <- if (is.null(dependencies$Ident[i])) TRUE else is.na(dependencies$Ident[i]) | dependencies$Ident[i] == ""
# if (testkey & testid) {
# stop(paste("No key nor ident given for dependent variable: ", dependencies$Name[i], "!", sep = ""))
# }
# if (!testkey) {
# objects.get(dependencies$Key[i]) # Key is the R-tools session identifier (shown at the end of the url)
# }
# if (testkey & !testid) {
# ident <- strsplit(as.character(dependencies$Ident[i]), "/")[[1]] # Ident should be in format <page_id>/<code_name>
# objects.latest(ident[1], ident[2])
# }
# if (evaluate) assign(
# as.character(dependencies$Name[i]),
# EvalOutput(get(as.character(dependencies$Name[i])), ...),
# envir = .GlobalEnv
# )
# if (verbose) cat("\n", rep("-", indent), as.character(dependencies$Name[i]), "fetched successfully!\n")
# }
# }
# }
#} # no need to return anything since variables are written in global memory by objects.get
# Arvioinnin tulos
Tulos <- new("ovariable", name = "Tulos",
dependencies = data.frame(Name = c(
"Terveysvaikutukset",
"Altistuminen",
"Pitoisuus",
"tieliikennepäästöt",
"suorite"
), Ident = c(
"", "", "", "", "Op_fi3192/alustus"
)),
formula = function(dependencies, ...) {
ComputeDependencies(dependencies, ...)
# Leikataan turhat pois
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.
oprint(temp)
# Käydään päästö läpi rivi kerrallaan ja lasketaan pitoisuus, altistuminen ja terveysvaikutus.
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, ],
EvalOutput(Terveysvaikutukset, N = N)@output, by = NULL
)
)
}
return(out)
}
)
## Terveysvaikutukset
Terveysvaikutukset <- new(
"ovariable",
name = "Terveysvaikutukset",
dependencies = data.frame(
Name = c("Altistuminen") # , "erf", "bg.mort")
),
formula = function(dependencies, ...) {
ComputeDependencies(dependencies, ...)
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 <- Altistuminen * erf * bg.mort
return(out)
}
)
## Altistuminen
Altistuminen <- new(
"ovariable",
name = "Altistuminen",
dependencies = data.frame(
Name = c("Pitoisuus", "LO", "LA")
),
formula = function(dependencies, ...) {
ComputeDependencies(dependencies, ...)
out <- GIS.Exposure(Pitoisuus, LO, LA, ...)
return(out)
}
)
## Pitoisuus
Pitoisuus <- new(
"ovariable",
name = "Pitoisuus",
dependencies = data.frame(
Name = c("Päästö", "LO", "LA")
),
formula = function(dependencies, ...) {
ComputeDependencies(dependencies, ...)
temp <- GIS.Concentration.matrix(Päästö, LO, LA, ...)
return(temp)
}
)
Päästö <- 1
LA <- 61.477491
LO <- 21.787756
################# 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")]
}
)
Tulos <- EvalOutput(Tulos)
if(intermediates) {
cat("Liikennesuorite.\n")
oprint(suorite@data)
cat("Kokonaispienhiukkaspäästöt eri pisteistä.\n")
oprint(tieliikennepäästöt)
cat("Yksityiskohtaiset päästötiedot.\n")
oprint(temp)
cat("Yksityiskohtainen lopputulos.\n")
oprint(Tulos)
}
#if(N > 10) {ggplot(temp, aes(x = Freq, fill = Vaihtoehto)) + geom_density(alpha = 0.2)}
cat("Pienhiukkasten aiheuttamia ylimääräisiä kuolemantapauksia vuodessa.\n")
ggplot(Tulos@output, aes(x = TerveysvaikutuksetResult, fill = Vaihtoehto)) + geom_density()
oprint(Tulos@output[Tulos@output$Iter == 1, ])
#################################
# Draw a concentration map.
par(mfrow=c(6,1), mar=c(3,1,0,1), cex=1.5)
colorstrip <- function(colors, labels) {
count <- length(colors)
m <- matrix(1:count, count, 1)
image(m, col=colors, ylab="", axes=FALSE)
axis(1,approx(c(0, 1), n=length(labels))$y, labels)
}
cat("Esimerkki yhden päästöpisteen aiheuttamasta pitoisuuskentästä.\n")
temp <- EvalOutput(Pitoisuus, N = 1)
temp2 <- gsub("\\(", "", temp@output$LObin)
temp2 <- gsub("\\]", "", temp2)
temp2 <- strsplit(temp2, ",")
temp3 <- c()
for(i in 1:length(temp2)) {
a <- as.numeric(temp2[[i]][1])
b <- as.numeric(temp2[[i]][2])
temp3[i] <- ((a + b) / 2)
}
temp@output$LO <- temp3
temp2 <- gsub("\\(", "", temp@output$LAbin)
temp2 <- gsub("\\]", "", temp2)
temp2 <- strsplit(temp2, ",")
temp3 <- c()
for(i in 1:length(temp2)) {
a <- as.numeric(temp2[[i]][1])
b <- as.numeric(temp2[[i]][2])
temp3[i] <- ((a + b) / 2)
}
temp@output$LA <- temp3
#print(temp)
data <- data.frame(LO=temp@output$LO, LA=temp@output$LA, concentration=temp@output$PitoisuusResult)
data$truncated_concentration <- ifelse(data$concentration > 1, 1, data$concentration)
# Plot the data
coordinates(data)=c("LO","LA")
proj4string(data)<-("+init=epsg:4326")
epsg4326String <- CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs")
shp<-spTransform(data,epsg4326String)
#Create blank raster
rast<-raster()
#Set raster extent to that of point data
extent(rast)<-extent(shp)
#Choose number of columns and rows
ncol(rast) <- 41
nrow(rast) <- 41
#cat("<span style='font-size: 1.2em;font-weight:bold;'>PM2.5</span>\n")
#Rasterize point data
rast2<-rasterize(shp, rast, shp$truncated_concentration, fun=mean)
steps <- c(0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1)
colors <- rev(rainbow(length(steps), start=0, end=0.50))
colorstrip(colors, steps)
#Plot data
google.show_raster_on_maps(rast2, col=colors, style="height:500px;")
| |
Ovariablet:
- Terveysvaikutukset: syötteenä Altistuminen * erf * bg.mort
- erf: vakio, annetaan koodissa
- bg.mort: vakio, annetaan koodissa
- Altistuminen: syötteenä Pitoisuus, LO, LA
- Käytetään funktiota GIS.Exposure(Pitoisuus, LO, LA, ...)
- LO ja LA: saadaan muuttujan Pitoisuus sarakkeista LO ja LA.
- Pitoisuus: syötteenä Päästö, LO, LA.
- LO ja LA: saadaan muuttujan Päästö sarakkeista LO ja LA.
- Käytetään funktiota GIS.Concentration.matrix(Päästö, LO, LA, ...)
- Päästö: syötteenä Tieliikennepäästöt (tässä kohdassa lähinnä yksikköskaalausta).
Data
Ero sivun ”Pori” versioiden välillä(-)Obs | Vaihtoehto | Ajoneuvo | Ajo | Kuormitusaste | LA | LO | Unit | Liikennemäärä | Pituus | Description |
---|
1 | Matkakeskus linja-autoasemalla | Täysperävaunuyhdistelmä | Katuajo | 70% kuorma | 61.131634 | 21.491318 | kpl-km /d | 100 | 2 | Päästöpiste oletetaan nykyiselle linja-autoasemalle |
2 | Matkakeskus rautatieasemalla | Täysperävaunuyhdistelmä | Katuajo | 70% kuorma | 61.131634 | 21.491318 | kpl-km /d | 100 | 2 | Päästöpiste oletetaan rautatieasemalle |
--#: Laskennan testaamiseksi siirretään Pori Rauman keskustaan. Todellinen sijainti on 61.477491, 21.787756 (rautatieasema) ja 61.481462, 22.798688 (linja-autoasema). --Jouni Tuomisto 16. maaliskuuta 2013 kello 10.40 (EET)
Katso myös
Avainsanat
Viitteet
Aiheeseen liittyviä tiedostoja
<mfanonymousfilelist></mfanonymousfilelist>