+ Näytä koodi- Piilota koodi
# Luetaan liikennemaarat Opasnet Base-tietokannasta, muuttujasta Op_fi2681:
#
library(OpasnetBaseUtils)
risteykset <- op_baseGetData("opasnet_base", "Op_fi2681", series_id = 2953)
#
# Muutetaan tekstitulokset numeroiksi. Jostain syystä Länteen tallentui tekstinä.
risteykset[!is.na(risteykset$Result.Text), "Result"] <- as.numeric(risteykset[!is.na(risteykset$Result.Text), "Result.Text"])
risteykset <- reshape(risteykset[, 3:5], timevar = "Ilmansuunta", idvar = "Risteys", direction = "wide")
risteykset[is.na(risteykset)] <- 0
risteykset <- risteykset[, c(1,2,4,5,3)]
colnames(risteykset) <- c("Risteys","Pohjoiseen","Itään","Etelään","Länteen")
# Eristetaan risteyspisteet omaan vektoriin:
#
risteyspisteet <- risteykset[[1]]; dim(risteyspisteet)<-c(9,13)
# Muodostetaan ylimaaraiset rivit ja sarakkeet lahinaapuritaulukointia varten
# (ita-lansi -suunnassa reunapisteiden nimena "AA" ja pohjois-etela -suunnassa "BB", nurkissa "XX"):
#
test3 <- c(1:(15*11)); dim(test3) <- c(11,15); test3 <- test3*0;
test3[2:10,2:14]<-as.character(risteyspisteet); test3[1:11,1] <- "AA"; test3[1:11,15] <- "AA"; test3[1,2:14] <- "BB"; test3[11,2:14] <- "BB";
test3[1,1] <- "XX"; test3[1,15] <- "XX"; test3[11,1] <- "XX"; test3[11,15] <- "XX";
# Luetaan myos liikennesuunnitelma tietokannasta
liikennesuunnitelmat <- op_baseGetData("opasnet_base", "Op_fi2681")
#
# Eristetaan suunnitelmasarake omaksi muuttujakseen
liikennesuunnitelmat2 <- liikennesuunnitelmat[[5]]
#
# Haetaan suunnitelman nimi viimeisen kantaan talletetun suunnitelman perusteella:
suunnitelma.nimi <- liikennesuunnitelmat2[[length(liikennesuunnitelmat2)]]
#
# apuV1-muuttujaan kootaan lista niista liikennesuunnitelmat2-listan alkioiden paikoista, joissa
# esiinty liikennesuunnitelman nimi (=suunnitelma.nimi)
apuV1 <- which(liikennesuunnitelmat2 == suunnitelma.nimi); apu.lkm <- length(apuV1)
#
# apuV2-muuttujan jokainen alkio sisaltaa 6-alkioisen alivektorin, joihin liikennesuunnitelman osat
# siirretaan liikennesuunnitelmat2-vektorista:
#
apuV2 <- list(1:apu.lkm); for(i in 1:apu.lkm) {apuV2[[i]] <- (apuV1[[i]] - 5):apuV1[[i]]};
apuV2 <- unlist(apuV2);
liikennesuunnitelmat2 <- liikennesuunnitelmat2[apuV2]
#
# Listassa useat suunnitelman osat toistuvat, koska oman varhaisemman suunnitelmansa tunnusluvut
# voi laskea tallettamalla suunnitelman nimen tietokantaan (talloin tallentuu koko 6-alkioinen
# suunnitelman osa samalla kertaa). Tasta johtuen useat alkiot toistuvat kannassa ja turhat
# toistuvat alkiot taytyy poistaa ennen analyysin jatkamista.
# Poistetaan liikennesuunnitelmat2-listan alkioista toistuvat alkiot unique-komennolla. Tata varten
# muodostetaan liikennesuunnitelmat2-muuttujasta ensin formaalisti listamuotoinen
# liikennesuunnitelmalista-muuttuja:
#
apu.lkm <- length(liikennesuunnitelmat2)/6;
liikennesuunnitelmalista <- list(1:apu.lkm);
for(i in 1:apu.lkm) {liikennesuunnitelmalista[[i]] <- liikennesuunnitelmat2[((i-1)*6+1):(6*i)]};
liikennesuunnitelmalista <- unique(liikennesuunnitelmalista)
#
# Puretaan listarakenne unlist-komennolla:
liikennesuunnitelmalista <- unlist(liikennesuunnitelmalista)
#
# Eristetaan x- ja y-koordinaatit liikennesuunnitelmalista-muuttujasta:
#
apu.lkm <- length(liikennesuunnitelmalista)/6
polku.apu <- list(1:apu.lkm); for(i in 1:apu.lkm) {polku.apu[[i]] <- liikennesuunnitelmalista[((i-1)*6+2):((i-1)*6+5)]}
#
# Maaritetaan lahtopiste
apu.x <- c(1:9); lahto.x <- sum(as.numeric(apu.x == polku.apu[[1]][1])*c(1:9));
apu.y <- c("A","B","C","D","E","F","G","H","I","J","K","L","M"); lahto.y <- sum(as.numeric(apu.y == polku.apu[[1]][2])*c(1:13))
#lahto.x;lahto.y
#
# Maaritetaan loppupiste
loppu.x <- sum(as.numeric(apu.x == polku.apu[[1]][3])*c(1:9))
loppu.y <- sum(as.numeric(apu.y == polku.apu[[1]][4])*c(1:13))
#loppu.x;loppu.y
#
# Maaritetaan onko muutos x- vai y-suuntaan:
if(loppu.x - lahto.x == 0) muutos.x <- 0 else muutos.x <- 1;
if(muutos.x == 0) muutos.y <- 1 else muutos.y <- 0
#
# Maaritetaan muutoksen maara
ero.x <- loppu.x - lahto.x; ero.y <- loppu.y - lahto.y;
#muutos.x; ero.x; muutos.y; ero.y
#
#for(x in lahto.x:loppu.x) {for(y in lahto.y:loppu.y) { print(test3[11*y + x + 1]) }}
# Poluksi maaritellaan pistejoukko vertekseja
#
polku<-c("E9","E8","F8","F7","F6","F5","F4","G4","G3","G2","G1")
# Maaritellaan lahinaapurilista kaikille polun pisteille:
#
lahinaapurilista <- list(1:(4*length(polku))); for(i in 1:length(polku)) {apuL <- which(test3 == polku[[i]]);
naapurit <-c(apuL+11,apuL-1,apuL-11,apuL+1); lahinaapurilista[[4*(i-1)+1]] <- naapurit[[1]];
lahinaapurilista[[4*(i-1)+2]] <- naapurit[[2]]; lahinaapurilista[[4*(i-1)+3]] <- naapurit[[3]];
lahinaapurilista[[4*(i-1)+4]] <- naapurit[[4]]}; lahinaapurit <- as.numeric(lahinaapurilista)
#
# Maaritellaan lahinaapuritN-vektori
#
lahinaapuritN <- list(1:length(lahinaapurit));
for(y in 1:length(lahinaapurit)) {lahinaapuritN[[y]] <- which(as.character(risteykset[[1]]) == test3[lahinaapurit][[y]])}
# Poistetaan listasta polun koordinaattipisteet:
#
polkuN <- list(1:length(polku));
for(i in 1:length(polku)) {polkuN[[i]] <- which(test3 == polku[[i]])}; num_polku <- as.numeric(polkuN)
# Maaritellaan apu_kampa, joka kertoo missa poistettavat polun elementit sijaitsevat lahinaapurilistassa:
#
apu_kampa<-as.numeric(lahinaapurit %in% num_polku)*(1:length(lahinaapurit));
# Maaritetaan muuttujan apu_kampa avulla lyhennetty lahinaapurilista, josta on poistettu polun elementit:
#
mod_lahinaapurit <- c(1:length(lahinaapurit));
for(i in 1:length(lahinaapurit)) {if(i==apu_kampa[[i]]) mod_lahinaapurit[[i]] <- 0 else mod_lahinaapurit[[i]] <- lahinaapurit[[i]]};
mod_lahinaapurit <- mod_lahinaapurit[mod_lahinaapurit != 0]
# Poistetaan lahinaapurilistasta termit "AA" ja "BB". Ensin varmistetaan onko listassa naita termeja maarittelemalla
# muuttuja flag. Jos flag saa arvon TRUE, lahinaapurilista sisaltaa elementteja AA tai BB, ja ne poistetaan:
#
if(sum(as.numeric(test3[mod_lahinaapurit] == "AA" | test3[mod_lahinaapurit] == "BB")) == 0) flag <- TRUE else flag <- FALSE;
if(flag == FALSE) apu_kampa <- which(test3[mod_lahinaapurit] == "AA" | test3[mod_lahinaapurit] == "BB");
if(flag == FALSE) mod_lahinaapurit <- mod_lahinaapurit[-apu_kampa]
# Uuteen muuttujaan nimelta lahinaapuri_risteykset kerataan mod_lahinaapurit-alkioita vastaavat risteyskoordinaatit
# risteykset-listasta (emme suoraan voi valita risteykset-listasta mod_lahinaapurit-alkoiden perusteella,
# koska jalkimmaiset on maaritetty laajemman test3-taulukon perusteella joka sisaltaa ylimaaraisia reunapisteita)
#
lahinaapuri_risteykset <- list(1:length(mod_lahinaapurit)); for(i in 1:length(mod_lahinaapurit)) {lahinaapuri_risteykset[[i]] <- which(risteykset[[1]] == as.list(test3[mod_lahinaapurit])[[i]])}
# Lasketaan painokertoimet kaikille risteyspisteille niiden liikennemaarien perusteella. Painokerroin = sarakkeen
# liikennemaara/kokonaisliikennemaara ja kokonaisliikennemaara = sarakkeen kaikkien arvojen summa.
# Vaikka monet risteykset esiintyvat monta kertaa, ei se haittaa vaikka ne lasketaankin mukaan joka kerran, koska
# jos risteyspiste on lahinaapuripiste useammalle polun pisteelle, pitaa sita painottaakin suuremmalla kertoimella.
#
# Painokerrointen mukainen jaettava eri ilmansuunnille (sarakkeet V2-V5) saadaan laskemalla ensin mitka ovat polun
# kokonaisliikennemaarat eri ilmansuuntiin ja kuinka paljon ne pienenevat esim. pyorakaistan rakentamisen
# yhteydessa.
#
# Ensin haetaan polku-muuttujan risteysten paikat (jarjestysnumerot) risteykset-taulukosta:
#
polku_risteykset <- list(1:length(polku));
for(i in 1:length(polku)) {polku_risteykset[[i]] <- which(risteykset[[1]] == polku[[i]])}
# Polun kokonaisliikennemaara (num_polun_liikennemaara) saadaan seuraaavasti
# (risteykset[as.numeric(polku_risteykset),i]-kutsu tuottaa listan liikennemaarista ilmansuuntaan i
# jokaisessa polun pisteessa):
#
polun_liikennemaara <- list(2:5);
for(i in 2:5) {polun_liikennemaara[[i]] <- sum(risteykset[as.numeric(polku_risteykset),i])};
num_polun_liikennemaara <- as.numeric(polun_liikennemaara[2:5]);
# Oletetaan, etta pyorakaistojen vetaminen ja pyorataskujen rakentaminen risteyksiin pienentaa autojen
# (= pikkuautojen ja bussien) liikennemaaria 10% lisaantyneen odotusajan jne. vuoksi (pyorailijoiden on
# paastava lahtemaan taskusta ennen autoilijoita).
#
# Maaritellaan jaettava liikennemaara vektoriin jaettava (= liikennemaara joka taytyy jakaa polun
# lahinaapuriristeyksiin):
#
jaettava <- 0.1*num_polun_liikennemaara;
# Jotta kokonaisliikennesuorite ei olisi sailyva suure maaritetaan jaettava-muuttuja uudella tavalla.
# Yksinkertainen tapa on muuttaa jaettava-muuttujassa P (= Pohjoinen), E (= Etela) ja I (= Ita), L (= Lansi)
# -sarakkeiden paikkaa. Maaritellaan siis jaettava_rotate -muuttuja:
#
jaettava_rotate <- c(1,1,1,1); jaettava_rotate[1] <- jaettava[2];
jaettava_rotate[2] <- jaettava[3]; jaettava_rotate[3] <- jaettava[4];
jaettava_rotate[4] <- jaettava[1]
# Lasketaan painokertoimet kaikille ilmansuunnille kaikissa lahinaapuripisteissa. Maaritetaan ensin
# paljonko liikennemaaraa on eri ilmansuuntiin kaikkien polun lahinaapureiden osalta:
#
lnaapuri_liikennemaara <- list(2:5);
for(i in 2:5) {lnaapuri_liikennemaara[[i]] <- sum(risteykset[as.numeric(lahinaapuri_risteykset),i])};
num_lnaapuri_liikennemaara <- as.numeric(lnaapuri_liikennemaara[2:5])
#
# Seuraavaksi lasketaan painokertoimet:
#
painokertoimet <- list(1:length(lahinaapuri_risteykset));
for(i in 1:length(lahinaapuri_risteykset)) {painokertoimet[[i]] <- risteykset[as.numeric(lahinaapuri_risteykset)[i],2:5]/num_lnaapuri_liikennemaara}
# Paljonko saadaan eri ilmansuuntiin jaettavaa joka risteyksessa on koodattu
# muuttujaan jaettavaa_per_risteys:
#
jaettava_per_risteys <- list(1:length(lahinaapuri_risteykset));
for(i in 1:length(lahinaapuri_risteykset)) {jaettava_per_risteys[[i]] <- painokertoimet[[i]]*jaettava_rotate}
# Viela pitaa vahentaa 'jaettava' jokaisesta risteyksesta polku-muuttujassa ja lisata
# jaettava_per_risteys-maara liikennetta jokaiseen lahinaapuriristeykseen jokaisessa ilmansuunnassa.
# Nain malli sailyttaa kokonaisliikennemaaran.
#
# Ensin on maaritettava paljonko polulta liikennemaaraa poistetaan. Talletetaan modifioitu liikennemaaratieto
# taulukkoon risteykset2. Ensin polku-muuttujan osalta:
#
risteykset2 <- risteykset;
for(i in 1:length(polku)) {risteykset2[as.numeric(polku_risteykset),][i,2:5] <- risteykset[as.numeric(polku_risteykset),][i,2:5] - (risteykset[as.numeric(polku_risteykset),][i,2:5]/num_polun_liikennemaara)*jaettava_rotate}
# Tehdaan sama homma polun lahinaapureille (eli sovelletaan samaa kaavaa kuin polulle) ja talletetaan
# muutokset taulukkoon risteykset2. Yo. kaavassa risteykset2-muuttujalle pitaa korvat length(polku) termilla
# length(lahinaapuri_risteykset) ja polku_risteykset -muuttuja lahinaapuri_risteykset -muuttujalla, seka
# summata edellisiin risteykset-muuttujan arvoihin jaettava_per_risteys jokaisessa lahinaapuriristeyksessa:
#
for(i in 1:length(lahinaapuri_risteykset)) {risteykset2[as.numeric(lahinaapuri_risteykset),][i,2:5] <- risteykset[as.numeric(lahinaapuri_risteykset),][i,2:5] + jaettava_per_risteys[[i]]}
# Kokonaisliikennemaarat koko katuverkossa saadaan summaamalla suoritteet jokaisessa hilapisteessa. Linkit
# tulee talloin laskettua kahteen kertaan, mika on oikein siita syysta, etta liikennemaarat ovat 'suunnattuja'.
# Oletuksena on etta molempiin suuntiin kulkee joka linkissa yhta paljon liikennetta ja nettovirta on nolla
# seka linkeissa etta risteyksissa. Lasketaan ensin uusi kokonaisliikennemaara (= kokonaisliikennemaara2)
#
kokonaisliikennemaara2 <- sum(sum(as.numeric(risteykset2[[2]])),sum(as.numeric(risteykset2[[3]])),sum(as.numeric(risteykset2[[4]])),sum(as.numeric(risteykset2[[5]])))
#
# Verrataan sita vanhaan
#
kokonaisliikennemaara <- sum(sum(as.numeric(risteykset[[2]])),sum(as.numeric(risteykset[[3]])),sum(as.numeric(risteykset[[4]])),sum(as.numeric(risteykset[[5]])))
# Liikennesuoritteet sen sijaan muuttuvat. Liikennemaarat pitaa kertoa korttelidimensioilla. P-E-suunnassa
# korttelin sivunpituus on n.135 m (sarakkeet V2 ja V4) ja I-L -suunnassa n. 100 m (sarakkeet V3 ja V5).
# Maaritellaan ensin kokonaisliikennemaarat eri suuntiin:
#
kokonaisliikennemaara_suunta2 <- c(sum(as.numeric(risteykset2[[2]])),sum(as.numeric(risteykset2[[3]])),sum(as.numeric(risteykset2[[4]])),sum(as.numeric(risteykset2[[5]])))
#
# Verrataan tata vanhaan kokonaisliikennemaara_suunta -muuttujaan
#
kokonaisliikennemaara_suunta <- c(sum(as.numeric(risteykset[[2]])),sum(as.numeric(risteykset[[3]])),sum(as.numeric(risteykset[[4]])),sum(as.numeric(risteykset[[5]])))
# Lasketaan liikennesuorite2 (korttelipituudet muutettu kilometreiksi)
#
liikennesuorite2 <- (kokonaisliikennemaara_suunta2[1] + kokonaisliikennemaara_suunta2[3])*0.135 + (kokonaisliikennemaara_suunta2[2] + kokonaisliikennemaara_suunta2[4])*0.100
#
# Lasketaan vanha BAU-liikennesuoritte (korttelipituudet muutettu kilometreiksi)
#
liikennesuorite <- (kokonaisliikennemaara_suunta[1] + kokonaisliikennemaara_suunta[3])*0.135 + (kokonaisliikennemaara_suunta[2] + kokonaisliikennemaara_suunta[4])*0.100
# Lasketaan vaikutukset henkilökohtaiseen terveyteen
#
emis.factor.PM <- 0.1 # gkm^-1
#
PM.lethality <- c(-7.223e-004, 5.640e-006, 4.228e-005, 5.987e-005, 8.013e-005, 1.150e-004, 2.037e-004, 2.939e-004, 3.598e-004, 4.132e-004, 4.640e-004, 5.139e-004, 5.662e-004, 6.233e-004, 6.854e-004, 7.577e-004, 8.441e-004, 9.519e-004, 1.093e-003, 1.314e-003, 2.805e-003)
#
PM.lethality <- median(PM.lethality) # deaths/kg = # deaths/(1000 g)
#
# Ylimaarainen kuolleisuus/vuosi (liikennemaarat ylla on laskettu per paiva, taytyy siis kertoa 365:lla)
#
kuolleisuus2 <- (PM.lethality/1000)*emis.factor.PM*liikennesuorite2*365
#
# Ylimaarainen BAU-kuolleisuus (eli vanhalla liikennejarjestelylla)
#
kuolleisuus <- (PM.lethality/1000)*emis.factor.PM*liikennesuorite*365
#
# Vaikutus lasten ja nuorten hengityselinsairauksiin
# Lasketaan ensin paljonko liikennesuorite2:sta tulee lisäystä PM-päästöihin BAU-skenaarioon verrattuna (grammoissa)
# yhdessä vuorokaudessa: Lisäys saadaan lausekkeesta emis.factor.PM*(liikennesuorite2 - liikennesuorite).
# Oletataan että liikenteen päästöt häviävät keskustan alueelta (13*9-kortteliblokkia) yhdessä tunnissa. Tällöin
# keskimääräiseksi konsentraatioksi saadaan (emis.factor.PM*(liikennesuorite2 - liikennesuorite)/24)/Vkesk, missä
# keskusta-alueen tilavuus Vkesk = 135*(13-1)*100*(9-1)*100*2 m^3 = 2592000 m^3 (2 metrin korkeus oletettu perustuen
# PILTTI-raporttiin s.21, Dispersion analysis). Jatkuvaksi massatiheyseroksi saadaan (kokonaispäästöjen oletetaan
# pysyvän samana joka tunti. Vaikka tämä ei erityisesti pidä paikkaansa yöaikana, käytetään oletusta keskiarvo-
# mielessä jakamaan altistus kaikille vuorokauden tunneille tasaisesti) mikrogrammoissa (mug):
#
Vkesk <- 2592000;
massatiheysero.mug <- 10^6*emis.factor.PM*(liikennesuorite2 - liikennesuorite)/(24*Vkesk)
#
# Lasketaan altistus koko Joensuun populaatiolle. Jokainen 10 mikrogramman lisays kuutiometrissa aiheuttaa 1.30
# lisasairauspaivaa aikuiselle vuodessa ja lapselle (5v - 14v) 1.86 lisasairauspaivaa (ks. http://en.opasnet.org/w/ERF_for_short_term_PM10_exposure_and_lower_respiratory_symptoms_(LRS)). Nama arviot siis PM10-paastoille.
# Arvioidaan vaikutus lineaariseksi
spv.ero.aikuinen <- (massatiheysero.mug/10)*1.30;
spv.ero.lapsi <- (massatiheysero.mug/10)*1.86;
#
# Ks. http://en.opasnet.org/w/Assessment_on_impacts_of_emission_trading_on_city-level_(ET-CL)
# Lasketaan vaikutukset ympäristöön (hiilidioksidijalanjälki)
#
Emis.factor.CO2 = 153 # gkm^-1
#
# Muunnetaan päästöt kilokgrammoiksi vuodessa:
#
paastot.co2.2 <- liikennesuorite2*365*0.153
#
# BAU-paastot:
paastot.co2 <- liikennesuorite*365*0.153
# Lasketaan hankkeen kustannusarvio
# Kaupunkialueella pyorakaistat oletetaan maalattavaksi katuun (joko ajoradalle tai jalkakaytavaa osittamalla)
# ilman etta ajorataa tarvii leventaa. Myos pyorataskut maalataan risteysalueelle. Arvioidaan nain syntyvan
# pyorakaistan kuluiksi 1.5 €/m = 1500 €/km
#
price.factor.pk <- 1500 # €/km
#
# Maaritetaan polun Ita-Etela -suuntaisten korttelisivujen lukumaara (polku.lkm.IL):
#
polku.lkm.IL <- 0
for(i in 1:(length(polku)-1)) {ero <- abs(as.numeric(polku_risteykset)[i]-as.numeric(polku_risteykset[i+1])); if(ero < 9) polku.lkm.IL <- polku.lkm.IL + 1 else polku.lkm.IL <- polku.lkm.IL}
hinta.pk2 <- (polku.lkm.IL*0.135 + (length(polku) - 1 - polku.lkm.IL)*0.100)*price.factor.pk
#
# BAU-hinta on nolla euroa (yllapito- ym. kuluja ei ole huomioitu, ainoastaan rakennuskulut)
#
hinta.pk <- 0
# Lasketaan erotukset BAU-skenaarioon verrattuna
#
ero.paastot.co2 <- (paastot.co2.2 - paastot.co2)/1000
ero.hinta.pk <- (hinta.pk2 - hinta.pk)/1000
# Ero sairaspaivien lukumaarassa vuodessa 1000 henkea kohden vuodessa
spv.ero.henkilo <- (spv.ero.lapsi + spv.ero.aikuinen)*1000
# Esitetaan tulokset skenaario kerrallaan:
#
print("SKENAARIO: BAU (= NYKYTILANNE)"); print("Kokonaisliikennemaarä (autoa/vrk)"); kokonaisliikennemaara; print("Liikennesuorite (km/vrk)"); liikennesuorite; print("Hiilidioksidijalanjälki (1000 kg/v)"); paastot.co2/1000
#
print("SKENAARIO: KÄYTTÄJÄN TEKEMÄ LIIKENNESUUNNITELMA (risteykset lueteltu alla)"); polku; print("Kokonaisliikennemäärä (autoa/vrk)"); kokonaisliikennemaara2; print("Liikennesuorite (km/vrk)"); liikennesuorite2; print("MUUTOS pienhiukkaspäästöjen aiheuttamien sairauspäivien lukumäärässä tuhatta henkeä kohden (lkm/v)"); spv.ero.henkilo; print("MUUTOS hiilidioksidijalanjäljessä (1000 kg/v)"); ero.paastot.co2; print("Hinta-arvio toteutuksesta (1000 €)"); ero.hinta.pk
#
plotResults <- c(ero.hinta.pk,ero.paastot.co2,spv.ero.henkilo)
plotResults_num <- as.numeric(plotResults < 0)
colorbar <- c("blue","blue","blue")
colorbar[which(plotResults_num == 1)] <- "red"
barplot(plotResults, col=colorbar)
| |
