Ero sivun ”Joensuun keskustan liikennemalli J1” versioiden välillä
p (→Data) |
pEi muokkausyhteenvetoa |
||
Rivi 49: | Rivi 49: | ||
# Luetaan liikennemaarat Opasnet Base-tietokannasta, muuttujasta Op_fi2681: | # Luetaan liikennemaarat Opasnet Base-tietokannasta, muuttujasta Op_fi2681: | ||
# | # | ||
library( | library(OpasnetUtils) | ||
risteykset <- | risteykset <- opbase.data("Op_fi2681", series_id = 2953) # TARKISTA SERIES!!! | ||
# | # | ||
# Muutetaan tekstitulokset numeroiksi. Jostain syystä Länteen tallentui tekstinä. | # Muutetaan tekstitulokset numeroiksi. Jostain syystä Länteen tallentui tekstinä. | ||
Rivi 446: | Rivi 446: | ||
<rcode> | <rcode> | ||
library( | library(OpasnetUtils) | ||
library(xtable) | library(xtable) | ||
data <- | data <- opbase.data("Op_fi2681")[, -c(1,4)] | ||
data <- reshape(data, timevar = "Parameter", idvar = "obs", direction = "wide") | data <- reshape(data, timevar = "Parameter", idvar = "obs", direction = "wide") | ||
colnames(data) <- c("obs", "lisäys", "mihin.x", "mihin.y", "mistä.x", "mistä.y", "suunnitelma") | colnames(data) <- c("obs", "lisäys", "mihin.x", "mihin.y", "mistä.x", "mistä.y", "suunnitelma") |
Versio 9. heinäkuuta 2013 kello 06.45
Moderaattori:smxb (katso kaikki)
Sivun edistymistä ei ole arvioitu. Arvostuksen määrää ei ole arvioitu (ks. peer review). |
Lisää dataa
|
Sisällys
Rajaus
Liikennemalli J1 on yksinkertaistettu versio Helsingin seudun joukkoliikennemallista. Malli J1 on rajattu Joensuun ydinkeskustaan 9*13-korttelin hilaan. Mallia J1 käytetään osana 31.10.2011 Joensuussa järjestettävää Eracedu-koulutustapahtumaa.
Mallia voi kokeilla klikkaamalla otsikon 'Kaava' alta löytyvää 'Aja koodi' -näppäintä. Oman liikenneratkaisusi voit syöttää sisään vastaamalla kysymyksiin otsikon 'Data' alla. Jo syötetyt liikennesuunnitelmat otsikon 'Näytä tähänastiset ehdotukset' alla olevaa 'Aja koodi'-näppäintä painamalla
Määritelmä
Data
Mitä muutoksia haluaisit tehdä Joensuun liikennejärjestelyihin? Katso karttaa ja vastaa kysymyksiin.
library(OpasnetUtils) Obs <- max(opbase.data("Op_fi2681", series_id = 2960)[,"obs"])+1 data <- data.frame( obs = rep(Obs, 6), Parameter = c("mistä.x", "mistä.y", "mihin.x", "mihin.y", "lisäys", "suunnitelma"), Result = c(mistä.x, mistä.y, mihin.x, mihin.y, lisäys, suunnitelma)) opbase.upload(input = data, ident = "Op_fi2681", acttype = 5, who = wiki_username, unit = "-") cat("Kiitos ehdotuksestasi!") |
Kausaliteetti
- Ylävirtamuuttujia ei ole.
Yksikkö
Muuttujan tulokset on ilmaistu useissa yksiköissä (liikennesuorite, CO2-päästöt, pienhiukkaspäästöt, DALYt)
Liikenneskenaarion vaikutukset nykytilanteeseen (BAU) verrattuna
library(xtable) # Luetaan liikennemaarat Opasnet Base-tietokannasta, muuttujasta Op_fi2681: # library(OpasnetUtils) risteykset <- opbase.data("Op_fi2681", series_id = 2953) # TARKISTA SERIES!!! # # 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 polku-muuttuja: polku <- list(1:apu.lkm) # # LUUPPI ALKAA # for(m in 1:apu.lkm) { # Maaritetaan lahtopiste apu.x <- c(1:9); lahto.x <- sum(as.numeric(apu.x == polku.apu[[m]][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[[m]][2])*c(1:13)); # # Maaritetaan loppupiste loppu.x <- sum(as.numeric(apu.x == polku.apu[[m]][3])*c(1:9)); loppu.y <- sum(as.numeric(apu.y == polku.apu[[m]][4])*c(1:13)); # # Maaritetaan onko muutos x- vai y-suuntaan: if(loppu.x - lahto.x == 0) muutos.x <- 0 else muutos.x <- 1; if(loppu.y - lahto.y == 0) muutos.y <- 0 else muutos.y <- 1; # # Maaritetaan muutoksen maara ero.x <- loppu.x - lahto.x; ero.y <- loppu.y - lahto.y; # # Maaritellaan pituudet jos jompikumpi siirtymista on nolla: if(muutos.x == 0 & muutos.y > 0) alipolku <- c(1:(abs(ero.y)+1)); if(muutos.y == 0 & muutos.x > 0) alipolku <- c(1:(abs(ero.x)+1)); if(muutos.x == 0 & muutos.y == 0) alipolku <- 0; # # Muodostetaan vektori nimelta alipolku johon ladataan koordinaatteja pisteesta (lahto.x, lahto.y) alkaen pisteeseen # (loppu.x, loppu.y) asti, ilmaistuna polun koordinaateissa, jotka on talletettu taulukkoon test3: # for(x in lahto.x:loppu.x) {for(y in lahto.y:loppu.y) { if(muutos.x == 0 & muutos.y == 0) alipolku <- "XX" else alipolku[[muutos.y*y + muutos.x*x]] <- test3[11*y + x + 1] }} # polku[[m]] <- alipolku } # # LUUPPI PAATTYY # # Poistetaan polusta moninkertaiset alkiot ja elementti "XX" seka elementit "1"..."15", joita ilmestyy # tayte-elementeiksi R:ssa kun vektorin sijoitukset eivat jatku indeksiin 1 asti. Lopuksi poistetaan NA't komennolla na.exclude: # # polku # tulostus polku <- unique(unlist(polku)); polku <- polku[polku !=c("XX")]; polku <- polku[polku !=c("1")]; polku <- polku[polku !=c("2")]; polku <- polku[polku !=c("3")]; polku <- polku[polku !=c("4")]; polku <- polku[polku !=c("5")]; polku <- polku[polku !=c("6")]; polku <- polku[polku !=c("7")]; polku <- polku[polku !=c("8")]; polku <- polku[polku !=c("9")]; polku <- polku[polku !=c("10")]; polku <- polku[polku !=c("11")]; polku <- polku[polku !=c("12")]; polku <- polku[polku !=c("13")]; polku <- polku[polku !=c("14")]; polku <- polku[polku !=c("15")]; polku <- as.character(na.exclude(polku)) # polku # tulostus # Poluksi maaritellaan pistejoukko vertekseja, esim: # #polku<-c("E9","E8","F8","F7","F6","F5","F4","G4","G3","G2","G1") # # Tutkittavia vaihtoehtoja: # # suunnitelma Joensuu 1: #polku <- c("F1","F2","F3","F4","F5","F6","F7","F8","F8") # # suunnitelma Joensuu 2: #polku <- c("H1","H2","H3","H4","H5","H6","H7","H8","H9") # # suunnitelma Joensuu 3 #polku <- c("L1","L2","L3","L4","L5","L6","L7") # # suunnitelma Joensuu 4 (vrt. suunnitelma Joensuu 1): #polku <- c("A5","B5","C5","D5","E5","F5","G5","H4","I4","J4","K4","L4","M4") # # suunnitelma Joensuu 5 (vrt. samaan polkuun kun siirtokerroin 0.1 (Pyörätie )-> 1.0 (Kävelykatu) (suunnitelma Joensuu 6)) #polku <- c("A7","B7","C7","D7","E7","F7","G7","H7","I7","I6","I5","I4","I3","I2","I1") # # suunnitelma Joensuu 7 #polku <- c("L1","L2","L3","L4","L5","L6","L7","A1","B1","C1","D1","D2","D3","D4") # # suunnitelma Joensuu 8 #polku <- c("H1","H2","H3","H4","H5","H6","H7","H8","H9","L1","L2","L3","L4","L5","L6","L7","A1","B1","C1") # 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): # if(liikennesuunnitelmalista[[1]] == "Pyörätie") siirtokerroin <- 0.1; if(liikennesuunnitelmalista[[1]] == "Kävelykatu") siirtokerroin <- 1.0; # # STAND ALONE-koodissa ylla olevat 2 rivia on kommentoitava pois ja KORVATTAVA RIVILLA #siirtokerroin <- 0.1 # Pyörätie #siirtokerroin <- 1.0 # Kävelykatu # jaettava <- siirtokerroin*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} # jaettava_rotate tai jaettava # 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 tuloste <- data.frame(Suure = c("Skenaario", "Kokonaisliikennemäärä", "Liikennesuorite", "Hiilidioksidijalanjälki"), Yksikkö = c("", "autoa/vrk", "km/vrk", "1000 kg/v"), Arvo = c("Nykytilanne (BAU)", kokonaisliikennemaara, liikennesuorite, paastot.co2/1000)) print(xtable(tuloste), type='html') # #print("SKENAARIO: KÄYTTÄJÄN TEKEMÄ LIIKENNESUUNNITELMA (risteykset lueteltu alla)"); polku; print("Kokonaisliikennemäärä (autoa/vrk)"); kokonaisliikennemaara2; print("Liikennesuorite (km/vrk)"); liikennesuorite2; print("Hinta-arvio toteutuksesta (1000 €) = Raha"); ero.hinta.pk; print("MUUTOS hiilidioksidijalanjäljessä (1000 kg/v) = Luonto"); ero.paastot.co2; print("MUUTOS pienhiukkaspäästöjen aiheuttamien sairauspäivien lukumäärässä tuhatta herk. henkeä kohden (lkm/v) = Terveys"); spv.ero.henkilo tuloste <- data.frame(Suure = c("Skenaario", "Polku", "Kokonaisliikennemäärä", "Liikennesuorite", "Hinta-arvio toteutuksesta = Raha", "MUUTOS hiilidioksidijalanjäljessä = Luonto", "MUUTOS pienhiukkaspäästöjen aiheuttamien sairauspäivien lukumäärässä tuhatta herk. henkeä kohden = Terveys"), Yksikkö = c("", "", "autoa/vrk", "km/vrk", "1000 €", "1000 kg/v", "lkm/v"), Arvo = c("KÄYTTÄJÄN TEKEMÄ LIIKENNESUUNNITELMA", paste(polku, collapse = ", "), kokonaisliikennemaara2, liikennesuorite2, ero.hinta.pk, ero.paastot.co2, spv.ero.henkilo)) print(xtable(tuloste), type = 'html') # plotResults <- c(ero.hinta.pk,ero.paastot.co2,spv.ero.henkilo) plotResults_num <- as.numeric(plotResults < 0) colorbar <- c("red","red","red") colorbar[which(plotResults_num == 1)] <- "green" barplot(plotResults, col=colorbar, names.arg=c("Raha","Luonto","Terveys"), cex.axis=1.7, cex.names=1.7) #barplot(plotResults, col=colorbar, names.arg=c("Kustannus (1000 euroa)","Ero CO2-päästö vs BAU (1000 kg/v)","Ero sairaspäivissä/(1000 henk. v) vs BAU")) |
Tulokset
Näytä tähänastiset ehdotukset
library(OpasnetUtils) library(xtable) data <- opbase.data("Op_fi2681")[, -c(1,4)] data <- reshape(data, timevar = "Parameter", idvar = "obs", direction = "wide") colnames(data) <- c("obs", "lisäys", "mihin.x", "mihin.y", "mistä.x", "mistä.y", "suunnitelma") print(xtable(data), type = 'html') |
Katso myös
- Osallistuva_kaupunkisuunnittelu_-_Eracedu_2011
- Helsingin seudun liikennemalli
- Video liikennemallin ja liikennepelin esittelystä (Otavan opiston paja 8.9.2011)
Viitteet
Aiheeseen liittyviä tiedostoja
<mfanonymousfilelist></mfanonymousfilelist>