Ero sivun ”Joensuun keskustan liikennemalli J1” versioiden välillä
Opasnet Suomista
Siirry navigaatioon
Siirry hakuun
(→Kaava: visualisointi lisätty) |
(→Kaava: visualisointi) |
||
Rivi 304: | Rivi 304: | ||
print("Hinta-arvio toteutuksesta (k€)"); ero.hinta.pk | print("Hinta-arvio toteutuksesta (k€)"); ero.hinta.pk | ||
# | |||
plotResults <- c(ero.hinta.pk,ero.paastot.co2,spv.ero.henkilo) | plotResults <- c(ero.hinta.pk,ero.paastot.co2,spv.ero.henkilo) | ||
plotResults_num <- as.numeric(plotResults < 0) | plotResults_num <- as.numeric(plotResults < 0) |
Versio 14. lokakuuta 2011 kello 11.39
Moderaattori:Ei ole (katso kaikki) Kuinka ryhtyä moderaattoriksi? Sivun edistymistä ei ole arvioitu. Arvostuksen määrää ei ole arvioitu (ks. peer review). |
Lisää dataa
|
Sisällys
Rajaus
Liikennemalli J1 on yksinkertaistettu version Helsingin seudun joukkoliikennemallista. Malli J1 on rajattu Joensuun ydinkeskustaan 9*13-korttelin hilaan. Mallia J1 käytetään osana 29.9.2011 Joensuussa järjestettävää Eracedu-koulutustapahtumaa.
Mallia päivitetään, sitä voi kokeilla oletusarvoin klikkaamalla otsikon 'Kaava' alta löytyvää 'Aja koodi' -näppäintä.
Määritelmä
Data
Mitä muutoksia haluaisit tehdä Joensuun liikennejärjestelyihin? Katso karttaa ja vastaa kysymyksiin.
library(OpasnetBaseUtils) Obs <- max(op_baseGetData("opasnet_base", "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(dsn = "opasnet_base_write", 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)
Kaava
# Luetaan liikennemaarat Opasnet Base-tietokannasta, muuttujasta Op_fi2681: # library(OpasnetBaseUtils) risteykset <- op_baseGetData("opasnet_base", "Op_fi2681", series_id = 2953) # # Muutetaan tekstitulokset numeroiksi. Jostain syystä Länteen tallentui tekstinä. risteykset[!is.na(risteykset$Result.Text), "Result"] <- as.numeric(risteykset[!is.na(risteykset$Result.Text), "Result.Text"]) risteykset <- reshape(risteykset[, 3:5], timevar = "Ilmansuunta", idvar = "Risteys", direction = "wide") risteykset[is.na(risteykset)] <- 0 risteykset <- risteykset[, c(1,2,4,5,3)] colnames(risteykset) <- c("Risteys","Pohjoiseen","Itään","Etelään","Länteen") # Eristetaan risteyspisteet omaan vektoriin: # risteyspisteet <- risteykset[[1]]; dim(risteyspisteet)<-c(9,13) # Muodostetaan ylimaaraiset rivit ja sarakkeet lahinaapuritaulukointia varten # (ita-lansi -suunnassa reunapisteiden nimena "AA" ja pohjois-etela -suunnassa "BB", nurkissa "XX"): # test3<-c(1:(15*11)); dim(test3)<-c(11,15); test3<-test3*0; test3[2:10,2:14]<-as.character(risteyspisteet); test3[1:11,1] <- "AA"; test3[1:11,15] <- "AA"; test3[1,2:14] <- "BB"; test3[11,2:14] <- "BB"; test3[1,1] <- "XX"; test3[1,15] <- "XX"; test3[11,1] <- "XX"; test3[11,15] <- "XX"; # # Poluksi maaritellaan pistejoukko vertekseja # polku<-c("E9","E8","F8","F7","F6","F5","F4","G4","G3","G2","G1") # Maaritellaan lahinaapurilista kaikille polun pisteille: # lahinaapurilista <- list(1:(4*length(polku))); for(i in 1:length(polku)) {apuL <- which(test3 == polku[[i]]); naapurit <-c(apuL+11,apuL-1,apuL-11,apuL+1); lahinaapurilista[[4*(i-1)+1]] <- naapurit[[1]]; lahinaapurilista[[4*(i-1)+2]] <- naapurit[[2]]; lahinaapurilista[[4*(i-1)+3]] <- naapurit[[3]]; lahinaapurilista[[4*(i-1)+4]] <- naapurit[[4]]}; lahinaapurit <- as.numeric(lahinaapurilista) # # Maaritellaan lahinaapuritN-vektori # lahinaapuritN <- list(1:length(lahinaapurit)); for(y in 1:length(lahinaapurit)) {lahinaapuritN[[y]] <- which(as.character(risteykset[[1]]) == test3[lahinaapurit][[y]])} # Poistetaan listasta polun koordinaattipisteet: # polkuN <- list(1:length(polku)); for(i in 1:length(polku)) {polkuN[[i]] <- which(test3 == polku[[i]])}; num_polku <- as.numeric(polkuN) # Maaritellaan apu_kampa, joka kertoo missa poistettavat polun elementit sijaitsevat lahinaapurilistassa: # apu_kampa<-as.numeric(lahinaapurit %in% num_polku)*(1:length(lahinaapurit)); # Maaritetaan muuttujan apu_kampa avulla lyhennetty lahinaapurilista, josta on poistettu polun elementit: # mod_lahinaapurit <- c(1:length(lahinaapurit)); for(i in 1:length(lahinaapurit)) {if(i==apu_kampa[[i]]) mod_lahinaapurit[[i]] <- 0 else mod_lahinaapurit[[i]] <- lahinaapurit[[i]]}; mod_lahinaapurit <- mod_lahinaapurit[mod_lahinaapurit != 0] # Poistetaan lahinaapurilistasta termit "AA" ja "BB". Ensin varmistetaan onko listassa naita termeja maarittelemalla # muuttuja flag. Jos flag saa arvon TRUE, lahinaapurilista sisaltaa elementteja AA tai BB, ja ne poistetaan: # if(sum(as.numeric(test3[mod_lahinaapurit] == "AA" | test3[mod_lahinaapurit] == "BB")) == 0) flag <- TRUE else flag <- FALSE; if(flag == FALSE) apu_kampa <- which(test3[mod_lahinaapurit] == "AA" | test3[mod_lahinaapurit] == "BB"); if(flag == FALSE) mod_lahinaapurit <- mod_lahinaapurit[-apu_kampa] # Uuteen muuttujaan nimelta lahinaapuri_risteykset kerataan mod_lahinaapurit-alkioita vastaavat risteyskoordinaatit # risteykset-listasta (emme suoraan voi valita risteykset-listasta mod_lahinaapurit-alkoiden perusteella, # koska jalkimmaiset on maaritetty laajemman test3-taulukon perusteella joka sisaltaa ylimaaraisia reunapisteita) # lahinaapuri_risteykset <- list(1:length(mod_lahinaapurit)); for(i in 1:length(mod_lahinaapurit)) {lahinaapuri_risteykset[[i]] <- which(risteykset[[1]] == as.list(test3[mod_lahinaapurit])[[i]])} # Lasketaan painokertoimet kaikille risteyspisteille niiden liikennemaarien perusteella. Painokerroin = sarakkeen # liikennemaara/kokonaisliikennemaara ja kokonaisliikennemaara = sarakkeen kaikkien arvojen summa. # Vaikka monet risteykset esiintyvat monta kertaa, ei se haittaa vaikka ne lasketaankin mukaan joka kerran, koska # jos risteyspiste on lahinaapuripiste useammalle polun pisteelle, pitaa sita painottaakin suuremmalla kertoimella. # # Painokerrointen mukainen jaettava eri ilmansuunnille (sarakkeet V2-V5) saadaan laskemalla ensin mitka ovat polun # kokonaisliikennemaarat eri ilmansuuntiin ja kuinka paljon ne pienenevat esim. pyorakaistan rakentamisen # yhteydessa. # # Ensin haetaan polku-muuttujan risteysten paikat (jarjestysnumerot) risteykset-taulukosta: # polku_risteykset <- list(1:length(polku)); for(i in 1:length(polku)) {polku_risteykset[[i]] <- which(risteykset[[1]] == polku[[i]])} # Polun kokonaisliikennemaara (num_polun_liikennemaara) saadaan seuraaavasti # (risteykset[as.numeric(polku_risteykset),i]-kutsu tuottaa listan liikennemaarista ilmansuuntaan i # jokaisessa polun pisteessa): # polun_liikennemaara <- list(2:5); for(i in 2:5) {polun_liikennemaara[[i]] <- sum(risteykset[as.numeric(polku_risteykset),i])}; num_polun_liikennemaara <- as.numeric(polun_liikennemaara[2:5]); # Oletetaan, etta pyorakaistojen vetaminen ja pyorataskujen rakentaminen risteyksiin pienentaa autojen # (= pikkuautojen ja bussien) liikennemaaria 10% lisaantyneen odotusajan jne. vuoksi (pyorailijoiden on # paastava lahtemaan taskusta ennen autoilijoita). # # Maaritellaan jaettava liikennemaara vektoriin jaettava (= liikennemaara joka taytyy jakaa polun # lahinaapuriristeyksiin): # jaettava <- 0.1*num_polun_liikennemaara; # Jotta kokonaisliikennesuorite ei olisi sailyva suure maaritetaan jaettava-muuttuja uudella tavalla. # Yksinkertainen tapa on muuttaa jaettava-muuttujassa P (= Pohjoinen), E (= Etela) ja I (= Ita), L (= Lansi) # -sarakkeiden paikkaa. Maaritellaan siis jaettava_rotate -muuttuja: # jaettava_rotate <- c(1,1,1,1); jaettava_rotate[1] <- jaettava[2]; jaettava_rotate[2] <- jaettava[3]; jaettava_rotate[3] <- jaettava[4]; jaettava_rotate[4] <- jaettava[1] # Lasketaan painokertoimet kaikille ilmansuunnille kaikissa lahinaapuripisteissa. Maaritetaan ensin # paljonko liikennemaaraa on eri ilmansuuntiin kaikkien polun lahinaapureiden osalta: # lnaapuri_liikennemaara <- list(2:5); for(i in 2:5) {lnaapuri_liikennemaara[[i]] <- sum(risteykset[as.numeric(lahinaapuri_risteykset),i])}; num_lnaapuri_liikennemaara <- as.numeric(lnaapuri_liikennemaara[2:5]) # # Seuraavaksi lasketaan painokertoimet: # painokertoimet <- list(1:length(lahinaapuri_risteykset)); for(i in 1:length(lahinaapuri_risteykset)) {painokertoimet[[i]] <- risteykset[as.numeric(lahinaapuri_risteykset)[i],2:5]/num_lnaapuri_liikennemaara} # Paljonko saadaan eri ilmansuuntiin jaettavaa joka risteyksessa on koodattu # muuttujaan jaettavaa_per_risteys: # jaettava_per_risteys <- list(1:length(lahinaapuri_risteykset)); for(i in 1:length(lahinaapuri_risteykset)) {jaettava_per_risteys[[i]] <- painokertoimet[[i]]*jaettava_rotate} # Viela pitaa vahentaa 'jaettava' jokaisesta risteyksesta polku-muuttujassa ja lisata # jaettava_per_risteys-maara liikennetta jokaiseen lahinaapuriristeykseen jokaisessa ilmansuunnassa. # Nain malli sailyttaa kokonaisliikennemaaran. # # Ensin on maaritettava paljonko polulta liikennemaaraa poistetaan. Talletetaan modifioitu liikennemaaratieto # taulukkoon risteykset2. Ensin polku-muuttujan osalta: # risteykset2 <- risteykset; for(i in 1:length(polku)) {risteykset2[as.numeric(polku_risteykset),][i,2:5] <- risteykset[as.numeric(polku_risteykset),][i,2:5] - (risteykset[as.numeric(polku_risteykset),][i,2:5]/num_polun_liikennemaara)*jaettava_rotate} # Tehdaan sama homma polun lahinaapureille (eli sovelletaan samaa kaavaa kuin polulle) ja talletetaan # muutokset taulukkoon risteykset2. Yo. kaavassa risteykset2-muuttujalle pitaa korvat length(polku) termilla # length(lahinaapuri_risteykset) ja polku_risteykset -muuttuja lahinaapuri_risteykset -muuttujalla, seka # summata edellisiin risteykset-muuttujan arvoihin jaettava_per_risteys jokaisessa lahinaapuriristeyksessa: # for(i in 1:length(lahinaapuri_risteykset)) {risteykset2[as.numeric(lahinaapuri_risteykset),][i,2:5] <- risteykset[as.numeric(lahinaapuri_risteykset),][i,2:5] + jaettava_per_risteys[[i]]} # Kokonaisliikennemaarat koko katuverkossa saadaan summaamalla suoritteet jokaisessa hilapisteessa. Linkit # tulee talloin laskettua kahteen kertaan, mika on oikein siita syysta, etta liikennemaarat ovat 'suunnattuja'. # Oletuksena on etta molempiin suuntiin kulkee joka linkissa yhta paljon liikennetta ja nettovirta on nolla # seka linkeissa etta risteyksissa. Lasketaan ensin uusi kokonaisliikennemaara (= kokonaisliikennemaara2) # kokonaisliikennemaara2 <- sum(sum(as.numeric(risteykset2[[2]])),sum(as.numeric(risteykset2[[3]])),sum(as.numeric(risteykset2[[4]])),sum(as.numeric(risteykset2[[5]]))) # # Verrataan sita vanhaan # kokonaisliikennemaara <- sum(sum(as.numeric(risteykset[[2]])),sum(as.numeric(risteykset[[3]])),sum(as.numeric(risteykset[[4]])),sum(as.numeric(risteykset[[5]]))) # Liikennesuoritteet sen sijaan muuttuvat. Liikennemaarat pitaa kertoa korttelidimensioilla. P-E-suunnassa # korttelin sivunpituus on n.135 m (sarakkeet V2 ja V4) ja I-L -suunnassa n. 100 m (sarakkeet V3 ja V5). # Maaritellaan ensin kokonaisliikennemaarat eri suuntiin: # kokonaisliikennemaara_suunta2 <- c(sum(as.numeric(risteykset2[[2]])),sum(as.numeric(risteykset2[[3]])),sum(as.numeric(risteykset2[[4]])),sum(as.numeric(risteykset2[[5]]))) # # Verrataan tata vanhaan kokonaisliikennemaara_suunta -muuttujaan # kokonaisliikennemaara_suunta <- c(sum(as.numeric(risteykset[[2]])),sum(as.numeric(risteykset[[3]])),sum(as.numeric(risteykset[[4]])),sum(as.numeric(risteykset[[5]]))) # Lasketaan liikennesuorite2 (korttelipituudet muutettu kilometreiksi) # liikennesuorite2 <- (kokonaisliikennemaara_suunta2[1] + kokonaisliikennemaara_suunta2[3])*0.135 + (kokonaisliikennemaara_suunta2[2] + kokonaisliikennemaara_suunta2[4])*0.100 # # Lasketaan vanha BAU-liikennesuoritte (korttelipituudet muutettu kilometreiksi) # liikennesuorite <- (kokonaisliikennemaara_suunta[1] + kokonaisliikennemaara_suunta[3])*0.135 + (kokonaisliikennemaara_suunta[2] + kokonaisliikennemaara_suunta[4])*0.100 # Lasketaan vaikutukset henkilökohtaiseen terveyteen # emis.factor.PM <- 0.1 # gkm^-1 # PM.lethality <- c(-7.223e-004, 5.640e-006, 4.228e-005, 5.987e-005, 8.013e-005, 1.150e-004, 2.037e-004, 2.939e-004, 3.598e-004, 4.132e-004, 4.640e-004, 5.139e-004, 5.662e-004, 6.233e-004, 6.854e-004, 7.577e-004, 8.441e-004, 9.519e-004, 1.093e-003, 1.314e-003, 2.805e-003) # PM.lethality <- median(PM.lethality) # deaths/kg = # deaths/(1000 g) # # Ylimaarainen kuolleisuus/vuosi (liikennemaarat ylla on laskettu per paiva, taytyy siis kertoa 365:lla) # kuolleisuus2 <- (PM.lethality/1000)*emis.factor.PM*liikennesuorite2*365 # # Ylimaarainen BAU-kuolleisuus (eli vanhalla liikennejarjestelylla) # kuolleisuus <- (PM.lethality/1000)*emis.factor.PM*liikennesuorite*365 # # Vaikutus lasten ja nuorten hengityselinsairauksiin # Lasketaan ensin paljonko liikennesuorite2:sta tulee lisäystä PM-päästöihin BAU-skenaarioon verrattuna (grammoissa) # yhdessä vuorokaudessa: Lisäys saadaan lausekkeesta emis.factor.PM*(liikennesuorite2 - liikennesuorite). # Oletataan että liikenteen päästöt häviävät keskustan alueelta (13*9-kortteliblokkia) yhdessä tunnissa. Tällöin # keskimääräiseksi konsentraatioksi saadaan (emis.factor.PM*(liikennesuorite2 - liikennesuorite)/24)/Vkesk, missä # keskusta-alueen tilavuus Vkesk = 135*(13-1)*100*(9-1)*100*2 m^3 = 2592000 m^3 (2 metrin korkeus oletettu perustuen # PILTTI-raporttiin s.21, Dispersion analysis). Jatkuvaksi massatiheyseroksi saadaan (kokonaispäästöjen oletetaan # pysyvän samana joka tunti. Vaikka tämä ei erityisesti pidä paikkaansa yöaikana, käytetään oletusta keskiarvo- # mielessä jakamaan altistus kaikille vuorokauden tunneille tasaisesti) mikrogrammoissa (mug): # Vkesk <- 2592000; massatiheysero.mug <- 10^6*emis.factor.PM*(liikennesuorite2 - liikennesuorite)/(24*Vkesk) # # Lasketaan altistus koko Joensuun populaatiolle. Jokainen 10 mikrogramman lisays kuutiometrissa aiheuttaa 1.30 # lisasairauspaivaa aikuiselle vuodessa ja lapselle (5v - 14v) 1.86 lisasairauspaivaa (ks. http://en.opasnet.org/w/ERF_for_short_term_PM10_exposure_and_lower_respiratory_symptoms_(LRS)). Nama arviot siis PM10-paastoille. # Arvioidaan vaikutus lineaariseksi spv.ero.aikuinen <- (massatiheysero.mug/10)*1.30; spv.ero.lapsi <- (massatiheysero.mug/10)*1.86; # # Ks. http://en.opasnet.org/w/Assessment_on_impacts_of_emission_trading_on_city-level_(ET-CL) # Lasketaan vaikutukset ympäristöön (hiilidioksidijalanjälki) # Emis.factor.CO2 = 153 # gkm^-1 # # Muunnetaan päästöt kilokgrammoiksi vuodessa: # paastot.co2.2 <- liikennesuorite2*365*0.153 # # BAU-paastot: paastot.co2 <- liikennesuorite*365*0.153 # Lasketaan hankkeen kustannusarvio # Kaupunkialueella pyorakaistat oletetaan maalattavaksi katuun (joko ajoradalle tai jalkakaytavaa osittamalla) # ilman etta ajorataa tarvii leventaa. Myos pyorataskut maalataan risteysalueelle. Arvioidaan nain syntyvan # pyorakaistan kuluiksi 1.5 €/m = 1500 €/km # price.factor.pk <- 1500 # €/km # # Maaritetaan polun Ita-Etela -suuntaisten korttelisivujen lukumaara (polku.lkm.IL): # polku.lkm.IL <- 0 for(i in 1:(length(polku)-1)) {ero <- abs(as.numeric(polku_risteykset)[i]-as.numeric(polku_risteykset[i+1])); if(ero < 9) polku.lkm.IL <- polku.lkm.IL + 1 else polku.lkm.IL <- polku.lkm.IL} hinta.pk2 <- (polku.lkm.IL*0.135 + (length(polku) - 1 - polku.lkm.IL)*0.100)*price.factor.pk # # BAU-hinta on nolla euroa (yllapito- ym. kuluja ei ole huomioitu, ainoastaan rakennuskulut) # hinta.pk <- 0 # Lasketaan erotukset BAU-skenaarioon verrattuna # ero.paastot.co2 <- (paastot.co2.2 - paastot.co2)/1000 ero.hinta.pk <- (hinta.pk2 - hinta.pk)/1000 # Ero sairaspaivien lukumaarassa vuodessa 1000 henkea kohden vuodessa spv.ero.henkilo <- (spv.ero.lapsi + spv.ero.aikuinen)*1000 # Esitetaan tulokset skenaario kerrallaan: # print("SKENAARIO: BAU (= NYKYTILANNE)") print("Kokonaisliikennemaara (autoa/vrk)"); kokonaisliikennemaara; print("Liikennesuorite (km/vrk)"); liikennesuorite print("Hiilidioksidijalanjalki (kg/v)"); paastot.co2 print("Hinta-arvio toteutuksesta (€)"); hinta.pk print("-----------------------------------------------") print("SKENAARIO: KAYTTAJAN TEKEMA LIIKENNESUUNNITELMA") print("Kokonaisliikennemaara (autoa/vrk)"); kokonaisliikennemaara2; print("Liikennesuorite (km/vrk)"); liikennesuorite2 print("Pienhiukkaspaastojen aiheuttama ylimaaraiset sairauspaivat tuhatta henkea kohden (lkm/v)"); spv.ero.henkilo print("Hiilidioksidijalanjalki (1000 kg/v)"); ero.paastot.co2 print("Hinta-arvio toteutuksesta (k€)"); ero.hinta.pk # plotResults <- c(ero.hinta.pk,ero.paastot.co2,spv.ero.henkilo) plotResults_num <- as.numeric(plotResults < 0) colorbar <- c("blue","blue","blue") colorbar[which(plotResults_num == 1)] <- "red" barplot(plotResults, col=colorbar) |
Tulokset
Näytä tähänastiset ehdotukset
library(OpasnetBaseUtils) library(xtable) data <- op_baseGetData("opasnet_base", "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
- Helsingin seudun liikennemalli
- Osallistuva kaupunkisuunnittelu Joensuussa
- Joensuun keskustan liikennemalli J1
- Video liikennemallin ja liikennepelin esittelystä (Otavan opiston paja 8.9.2011)
Viitteet
Aiheeseen liittyviä tiedostoja
<mfanonymousfilelist></mfanonymousfilelist>