Ero sivun ”Joensuun keskustan liikennemalli J1” versioiden välillä
(→Kaava) |
(→Data) |
||
(48 välissä olevaa versiota 6 käyttäjän tekeminä ei näytetä) | |||
Rivi 1: | Rivi 1: | ||
{{muuttuja}} | {{muuttuja|moderator=smxb}} | ||
[[Luokka:Sisältää R-koodia]] | |||
== Rajaus == | == Rajaus == | ||
Liikennemalli J1 on | 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ä == | == Määritelmä == | ||
=== Data === | === Data === | ||
{{vastusta|#: |Laskenta ei toimi, koska obs-sarake on poistettu tietokantataulusta. Koodin päivittämiseksi pitäisi tehdä: | |||
* Palauttaa obs tai luoda vastaava uusi indeksi, esim. Ehdotus (myös vanhoihin syötteisiin!). | |||
* Tarkistaa, että koodeissa on oikea series_id: 3636. | |||
* Analyysikoodi on kirjoitettu hyödyntämättä ovariableja. Pitäisikö se miettiä kokonaan uusiksi? | |||
* Lopussa oleva terveysvaikutuslaskenta pitäisi toteuttaa uusimman [[:op_en:HIA|HIA]]-laskennan mukaisesti. | |||
* Olisiko tässä helpompi hyödyntää location-parametria käyttöliitymässä? | |||
|--[[Käyttäjä:Jouni|Jouni Tuomisto]] 7. lokakuuta 2013 kello 09.07 (EEST)}} | |||
Mitä muutoksia haluaisit tehdä Joensuun liikennejärjestelyihin? Katso karttaa ja vastaa kysymyksiin. | |||
[[Image:Gpick_shakki.png|450px|right|Joensuun keskusta]] | |||
<rcode variables=" | |||
name:mistä.x|description:Alkupisteen x-koordinaatti|type:selection|options:1;1;2;2;3;3;4;4;5;5;6;6;7;7;8;8;9;9 | |||
|name:mistä.y|description:Alkuposteen y-koordinaatti|type:selection|options:'A';A;'B';B;'C';C;'D';D;'E';E;'F';F;'G';G;'H';H;'I';I;'J';J;'K';K;'L';L;'M';M | |||
|name:mihin.x|description:Loppupisteen x-koordinaatti|type:selection|options:1;1;2;2;3;3;4;4;5;5;6;6;7;7;8;8;9;9 | |||
|name:mihin.y|description:Loppupisteen y-koordinaatti|type:selection|options:'A';A;'B';B;'C';C;'D';D;'E';E;'F';F;'G';G;'H';H;'I';I;'J';J;'K';K;'L';L;'M';M | |||
|name:lisäys|description:Mitä haluat lisätä tälle välille?|type:selection|options:'Pyörätie';Pyörätie;'Kävelykatu';Kävelykatu | |||
|name:suunnitelma|description:Voit antaa omalle suunnitelmallesi nimen, jolloin yksittäiset ehdotukset käsitellään kokonaisuutena (eli kaikki samannimiset suunnitelmat yhdistetään yhdeksi kokonaissuunnitelmaksi). Voit myöhemmin palata mihin tahansa tietokannasta löytyvään suunnitelmaan ja simuloida sen tunnusluvut kirjoittamalla sen nimen alla olevaan kenttään ja painamalla 'Aja koodi'-näppäintä. Vastaavasti uusi liikennesuunnitelma talletetaan tietokantaan kirjoittamalla suunnitelmasi nimi alla olevaan kenttään heittomerkkien väliin ja valitsemalla yllä olevista valikoista liikenneratkaisusi koordinaatit ja tietyyppi.|default:'suunnitelma Joensuu 3' | |||
"> | |||
library(OpasnetUtils) | |||
oprint(opbase.data("Op_fi2681", series_id = 3636)) | |||
Obs <- max(opbase.data("Op_fi2681", series_id = 3636)[,"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!") | |||
</rcode> | |||
=== Kausaliteetti === | === Kausaliteetti === | ||
Rivi 17: | Rivi 53: | ||
Muuttujan tulokset on ilmaistu useissa yksiköissä (liikennesuorite, CO2-päästöt, pienhiukkaspäästöt, DALYt) | Muuttujan tulokset on ilmaistu useissa yksiköissä (liikennesuorite, CO2-päästöt, pienhiukkaspäästöt, DALYt) | ||
=== | === Liikenneskenaarion vaikutukset nykytilanteeseen (BAU) verrattuna === | ||
<rcode graphics="1"> | |||
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") | |||
# | # | ||
polku<-c("A1","B1"," | # 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: | # 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) | 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 | # Maaritellaan lahinaapuritN-vektori | ||
Rivi 51: | Rivi 215: | ||
# Poistetaan listasta polun koordinaattipisteet: | # 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) | polkuN <- list(1:length(polku)); | ||
# Maaritellaan apu_kampa, joka kertoo missa poistettavat polun elementit | 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)); | apu_kampa<-as.numeric(lahinaapurit %in% num_polku)*(1:length(lahinaapurit)); | ||
# Maaritetaan muuttujan apu_kampa avulla lyhennetty lahinaapurilista, josta | # 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] | 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 | # 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: | |||
# | # | ||
apu_kampa <- which(test3[mod_lahinaapurit] == "AA" | test3[mod_lahinaapurit] == "BB"); | if(sum(as.numeric(test3[mod_lahinaapurit] == "AA" | test3[mod_lahinaapurit] == "BB")) == 0) flag <- TRUE else flag <- FALSE; | ||
mod_lahinaapurit <- mod_lahinaapurit[-apu_kampa] | 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]])} | 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 | # 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 | |||
# Vaikka monet risteykset esiintyvat monta kertaa, ei se haittaa vaikka | # jos risteyspiste on lahinaapuripiste useammalle polun pisteelle, pitaa sita painottaakin suuremmalla kertoimella. | ||
# | # | ||
# Painokerrointen mukainen jaettava eri ilmansuunnille (sarakkeet V2-V5) | # 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 | # 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]])} | 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: | # 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]) | 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 | # 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). | |||
# 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 <- | jaettava <- siirtokerroin*num_polun_liikennemaara; | ||
# Jotta kokonaisliikennesuorite ei olisi sailyva suure maaritetaan jaettava-muuttuja | # 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] | 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 | # 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: | # 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} | 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 | # Paljonko saadaan eri ilmansuuntiin jaettavaa joka risteyksessa on koodattu | ||
# muuttujaan jaettavaa_per_risteys: | # 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 | 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 | # 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 | # 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} | 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 | # 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 | |||
# length(lahinaapuri_risteykset) ja polku_risteykset -muuttuja | # 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] <- | 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 | # 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 | |||
# Oletuksena on etta molempiin suuntiin kulkee joka linkissa yhta paljon | # 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 | # 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: | # 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])*135 + (kokonaisliikennemaara_suunta[2] + kokonaisliikennemaara_suunta[4])*100 | 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")) | |||
</rcode> | </rcode> | ||
== Tulokset == | == Tulokset == | ||
===Näytä tähänastiset ehdotukset=== | |||
<rcode> | |||
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') | |||
</rcode> | |||
== Katso myös == | == Katso myös == | ||
* [[Osallistuva_kaupunkisuunnittelu_-_Eracedu_2011]] | |||
* [[Helsingin seudun liikennemalli]] | * [[Helsingin seudun liikennemalli]] | ||
* [ | * [http://www.viddler.com/explore/otavanopisto/videos/312/ Video liikennemallin ja liikennepelin esittelystä] (Otavan opiston paja 8.9.2011) | ||
== Viitteet == | == Viitteet == | ||
<references/> | <references/> | ||
==Aiheeseen liittyviä tiedostoja== | ==Aiheeseen liittyviä tiedostoja== | ||
{{mfiles}} | {{mfiles}} | ||
{{eracedu}} |
Nykyinen versio 7. lokakuuta 2013 kello 06.07
Moderaattori:smxb (katso kaikki)
Sivun edistymistä ei ole arvioitu. Arvostuksen määrää ei ole arvioitu (ks. peer review). |
Lisää dataa
|
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
⇤#: Laskenta ei toimi, koska obs-sarake on poistettu tietokantataulusta. Koodin päivittämiseksi pitäisi tehdä:
- Palauttaa obs tai luoda vastaava uusi indeksi, esim. Ehdotus (myös vanhoihin syötteisiin!).
- Tarkistaa, että koodeissa on oikea series_id: 3636.
- Analyysikoodi on kirjoitettu hyödyntämättä ovariableja. Pitäisikö se miettiä kokonaan uusiksi?
- Lopussa oleva terveysvaikutuslaskenta pitäisi toteuttaa uusimman HIA-laskennan mukaisesti.
- Olisiko tässä helpompi hyödyntää location-parametria käyttöliitymässä?
--Jouni Tuomisto 7. lokakuuta 2013 kello 09.07 (EEST)
Mitä muutoksia haluaisit tehdä Joensuun liikennejärjestelyihin? Katso karttaa ja vastaa kysymyksiin.
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
Tulokset
Näytä tähänastiset ehdotukset
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>