Ero sivun ”Joensuun keskustan liikennemalli J1” versioiden välillä
(koodia parannettu mutta vieläkin bugi) |
(→Data) |
||
(38 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. | Mitä muutoksia haluaisit tehdä Joensuun liikennejärjestelyihin? Katso karttaa ja vastaa kysymyksiin. | ||
[[Image:Gpick_shakki.png|450px|right|Joensuun keskusta]] | |||
<rcode variables=" | <rcode variables=" | ||
Rivi 16: | Rivi 29: | ||
|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.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: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;' | |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. | |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( | library(OpasnetUtils) | ||
Obs <- max( | oprint(opbase.data("Op_fi2681", series_id = 3636)) | ||
Obs <- max(opbase.data("Op_fi2681", series_id = 3636)[,"obs"])+1 | |||
data <- data.frame( | data <- data.frame( | ||
obs = rep(Obs, 6), | obs = rep(Obs, 6), | ||
Parameter = c("mistä.x", "mistä.y", "mihin.x", "mihin.y", "lisäys", "suunnitelma"), | 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)) | 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> | </rcode> | ||
=== Kausaliteetti === | === Kausaliteetti === | ||
Rivi 39: | 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> | <rcode graphics="1"> | ||
library( | library(xtable) | ||
risteykset <- | # 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ä. | # 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[!is.na(risteykset$Result.Text), "Result"] <- as.numeric(risteykset[!is.na(risteykset$Result.Text), "Result.Text"]) | ||
Rivi 51: | Rivi 69: | ||
colnames(risteykset) <- c("Risteys","Pohjoiseen","Itään","Etelään","Länteen") | colnames(risteykset) <- c("Risteys","Pohjoiseen","Itään","Etelään","Länteen") | ||
# Eristetaan risteyspisteet omaan vektoriin: | |||
# Eristetaan risteyspisteet omaan | |||
# | # | ||
risteyspisteet <- risteykset[[1]]; dim(risteyspisteet)<-c(9,13) | risteyspisteet <- risteykset[[1]]; dim(risteyspisteet)<-c(9,13) | ||
# Muodostetaan ylimaaraiset rivit ja sarakkeet lahinaapuritaulukointia varten | # Muodostetaan ylimaaraiset rivit ja sarakkeet lahinaapuritaulukointia varten | ||
# (ita-lansi -suunnassa reunapisteiden nimena "AA" ja pohjois-etela -suunnassa "BB", nurkissa "XX"): | # (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 <- 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[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"; | test3[1,1] <- "XX"; test3[1,15] <- "XX"; test3[11,1] <- "XX"; test3[11,15] <- "XX"; | ||
test3 | |||
# 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") | |||
# | # | ||
polku<-c("A1","B1"," | # 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: | # Maaritellaan lahinaapurilista kaikille polun pisteille: | ||
Rivi 83: | 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)) | mod_lahinaapurit <- c(1:length(lahinaapurit)); | ||
{if(i==apu_kampa[[i]]) mod_lahinaapurit[[i]] <- 0 else mod_lahinaapurit[[i]] <- lahinaapurit[[i]]}; | 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 <- 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 | # Uuteen muuttujaan nimelta lahinaapuri_risteykset kerataan mod_lahinaapurit-alkioita vastaavat risteyskoordinaatit | ||
Rivi 105: | Rivi 239: | ||
# koska jalkimmaiset on maaritetty laajemman test3-taulukon perusteella joka sisaltaa ylimaaraisia reunapisteita) | # 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 <- 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[[i]] <- which(risteykset[[1]] == as.list(test3[mod_lahinaapurit])[[i]])} | |||
# Lasketaan painokertoimet kaikille risteyspisteille niiden liikennemaarien perusteella. Painokerroin = sarakkeen | # Lasketaan painokertoimet kaikille risteyspisteille niiden liikennemaarien perusteella. Painokerroin = sarakkeen | ||
Rivi 120: | Rivi 253: | ||
# | # | ||
polku_risteykset <- list(1:length(polku)); | polku_risteykset <- list(1:length(polku)); | ||
for(i in 1:length(polku)) {polku_risteykset[[i]] <- which(risteykset[[1]] == polku[[i]])} | 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 | ||
Rivi 128: | Rivi 259: | ||
# jokaisessa polun pisteessa): | # jokaisessa polun pisteessa): | ||
# | # | ||
polun_liikennemaara <- list(2:5); for(i in 2:5) | polun_liikennemaara <- list(2:5); | ||
{polun_liikennemaara[[i]] <- sum(risteykset[as.numeric(polku_risteykset),i])}; | for(i in 2:5) {polun_liikennemaara[[i]] <- sum(risteykset[as.numeric(polku_risteykset),i])}; | ||
num_polun_liikennemaara <- as.numeric(polun_liikennemaara[2:5]); | num_polun_liikennemaara <- as.numeric(polun_liikennemaara[2:5]); | ||
Rivi 139: | Rivi 270: | ||
# lahinaapuriristeyksiin): | # 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. | # Jotta kokonaisliikennesuorite ei olisi sailyva suure maaritetaan jaettava-muuttuja uudella tavalla. | ||
Rivi 149: | Rivi 287: | ||
jaettava_rotate[4] <- jaettava[1] | 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]]))) | |||
# | # | ||
kokonaisliikennemaara <- sum(sum(as.numeric( | # 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])*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) | |||
# | # | ||
liikennesuorite <- ( | 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) | |||
* [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== | ||
Rivi 223: | Rivi 481: | ||
{{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>