Versio 16. maaliskuuta 2013 kello 08.39

Tämä sivu on tietokide alatyypiltään muuttuja. Sivutunniste: Op_fi3357
Moderaattori:Jouni (katso kaikki) Sivun edistyminen: Raakile. Arvostuksen määrää ei ole arvioitu (ks. peer review).
Lisää dataa {{#opasnet_base_link:Op_fi3357}}

Kysymys

Miten terveysvaikutusarviointi pitäisi huomioida kaupunkitason päätöksenteossa Porissa? Mitä kehityshankkeita on meneillään?

Vastaus

Perustelut

Pori: kokoukset
Terveysvaikutusten arviointi käyttöön päätöksenteon tueksi ja työvälineeksi Porin kaupungissa, valtuustoaloite, Päivi Kolehmainen 3.12.2012
Porin kaupunginvaltuuston kokous 21.1.2013, esityslistalla terveysvaikutusten arviointi [1]
Terveysvaikutusten arviointi Salossa (Stakes 2007)

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

Tämä sivu on tietokide alatyypiltään muuttuja. Sivutunniste: Op_fi3357
Moderaattori:Jouni (katso kaikki) Sivun edistyminen: Luonnos. Arvostuksen määrää ei ole arvioitu (ks. peer review).
Lisää dataa {{#opasnet_base_link:Op_fi3357}}

<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, ...) {

		#Perustetaan muuttujia joita kohta etsitään.

		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", "PäästöSource")], 
			sum
		)))

		temp <- temp[!is.na(temp$Freq), ] # Pudotetaan tyhjät rivit pois.

		# 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
print(temp)	
		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]))

			# 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
				)
			)

			# Nollataan Altistuminen ja Pitoisuus, jotta malli laskee ne uusiksi uudelle päästölle.

			Altistuminen@output <- data.frame()
			Pitoisuus@output <- data.frame()
		}
	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"),
		Ident = "Op_fi3192/alustus"
	),
	formula = function(dependencies, ...) {
		ComputeDependencies(dependencies, ...)

		out <- GIS.Exposure(Pitoisuus, LO, LA, ...)

		return(out)
	}
)

## Pitoisuudet

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ö <- 0
LO <- 0
LA <- 0

################# 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")]
	}
)

# suorite <- EvalOutput(suorite)


oprint(Altistuminen)
#Altistuminen
#Pitoisuus
#tieliikennepäästöt
#suorite
#Tulos <- EvalOutput(Tulos)
#oprint(Tulos)

if(intermediates) {cat("Liikennesuorite.\n"); oprint(suorite@data)

cat("Kokonaispienhiukkaspäästöt eri pisteistä.\n")
print(xtable(Päästö.temp@output), type = 'html')

if(intermediates) {cat("Yksityiskohtaiset päästötiedot.\n"); oprint(temp)}

if(intermediates) {cat("Yksityiskohtainen lopputulos.\n"); print(xtable(Lopputulos[Lopputulos$Iter == 1, ]), type = 'html')}

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)}

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')

#################################

# 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).
      - Tieliikennepäästöt: käyttää metodia Tieliikennepäästöt ja muuttujaa suorite.
        suorite: luodaan tämän sivun (Pienhiukkaspäästöt Raumalla) datataulusta.

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.481462	21.798688	kpl-km /d	100	2	Päästöpiste oletetaan nykyiselle linja-autoasemalle
2	Matkakeskus rautatieasemalla	Täysperävaunuyhdistelmä	Katuajo	70% kuorma	61.477491	21.787756	kpl-km /d	100	2	Päästöpiste oletetaan rautatieasemalle

Katso myös

Pienhiukkaspäästöt Raumalla

Avainsanat

Viitteet

Aiheeseen liittyviä tiedostoja

Ero sivun ”Pori” versioiden välillä

Versio 16. maaliskuuta 2013 kello 08.39

Sisällys

Kysymys

Vastaus

Perustelut

Riippuvuudet

Data

Laskenta

Matkakeskuksen pienhiukkaspäästöt

Kysymys

Vastaus

Perustelut

Laskenta

Data

Katso myös

Avainsanat

Viitteet

Aiheeseen liittyviä tiedostoja

Navigointivalikko