Joensuun keskustan liikennemalli J1

Tämä sivu on tietokide alatyypiltään muuttuja. Sivutunniste: Op_fi2681
Moderaattori:smxb (katso kaikki) Sivun edistymistä ei ole arvioitu. Arvostuksen määrää ei ole arvioitu (ks. peer review).
Lisää dataa {{#opasnet_base_link:Op_fi2681}}

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.

Alkupisteen x-koordinaatti:

Alkuposteen y-koordinaatti:

Loppupisteen x-koordinaatti:

Loppupisteen y-koordinaatti:

Mitä haluat lisätä tälle välille?:

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.:

+ Näytä koodi - Piilota koodi

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

+ Näytä koodi - Piilota koodi


# Luetaan liikennemaarat Opasnet Base-tietokannasta, muuttujasta Op_fi2681:
#
library(OpasnetBaseUtils)
risteykset <- op_baseGetData("opasnet_base", "Op_fi2681", series_id = 2953)
#
# Muutetaan tekstitulokset numeroiksi. Jostain syystä Länteen tallentui tekstinä.
risteykset[!is.na(risteykset$Result.Text), "Result"] <- as.numeric(risteykset[!is.na(risteykset$Result.Text), "Result.Text"])
risteykset <- reshape(risteykset[, 3:5], timevar = "Ilmansuunta", idvar = "Risteys", direction = "wide")
risteykset[is.na(risteykset)] <- 0
risteykset <- risteykset[, c(1,2,4,5,3)]
colnames(risteykset) <- c("Risteys","Pohjoiseen","Itään","Etelään","Länteen")


# Eristetaan risteyspisteet omaan vektoriin:
#
risteyspisteet <- risteykset[[1]]; dim(risteyspisteet)<-c(9,13)

# Muodostetaan ylimaaraiset rivit ja sarakkeet lahinaapuritaulukointia varten
# (ita-lansi -suunnassa reunapisteiden nimena "AA" ja pohjois-etela -suunnassa "BB", nurkissa "XX"):
#
test3 <- c(1:(15*11)); dim(test3) <- c(11,15); test3 <- test3*0;
test3[2:10,2:14]<-as.character(risteyspisteet); test3[1:11,1] <- "AA"; test3[1:11,15] <- "AA"; test3[1,2:14] <- "BB"; test3[11,2:14] <- "BB";
test3[1,1] <- "XX"; test3[1,15] <- "XX"; test3[11,1] <- "XX"; test3[11,15] <- "XX";


# Luetaan myos liikennesuunnitelma tietokannasta
liikennesuunnitelmat <- op_baseGetData("opasnet_base", "Op_fi2681")
#
# Eristetaan suunnitelmasarake omaksi muuttujakseen
liikennesuunnitelmat2 <- liikennesuunnitelmat[[5]]
#
# Haetaan suunnitelman nimi viimeisen kantaan talletetun suunnitelman perusteella:
suunnitelma.nimi <- liikennesuunnitelmat2[[length(liikennesuunnitelmat2)]]
#
# apuV1-muuttujaan kootaan lista niista liikennesuunnitelmat2-listan alkioiden paikoista, joissa
# esiinty liikennesuunnitelman nimi (=suunnitelma.nimi)
apuV1 <- which(liikennesuunnitelmat2 == suunnitelma.nimi); apu.lkm <- length(apuV1)
#
# apuV2-muuttujan jokainen alkio sisaltaa 6-alkioisen alivektorin, joihin liikennesuunnitelman osat
# siirretaan liikennesuunnitelmat2-vektorista:
#
apuV2 <- list(1:apu.lkm); for(i in 1:apu.lkm) {apuV2[[i]] <- (apuV1[[i]] - 5):apuV1[[i]]};
apuV2 <- unlist(apuV2);
liikennesuunnitelmat2 <- liikennesuunnitelmat2[apuV2]
#
# Listassa useat suunnitelman osat toistuvat, koska oman varhaisemman suunnitelmansa tunnusluvut
# voi laskea tallettamalla suunnitelman nimen tietokantaan (talloin tallentuu koko 6-alkioinen
# suunnitelman osa samalla kertaa). Tasta johtuen useat alkiot toistuvat kannassa ja turhat
# toistuvat alkiot taytyy poistaa ennen analyysin jatkamista.
# Poistetaan liikennesuunnitelmat2-listan alkioista toistuvat alkiot unique-komennolla. Tata varten
# muodostetaan liikennesuunnitelmat2-muuttujasta ensin formaalisti listamuotoinen
# liikennesuunnitelmalista-muuttuja:
#
apu.lkm <- length(liikennesuunnitelmat2)/6;
liikennesuunnitelmalista <- list(1:apu.lkm);
for(i in 1:apu.lkm) {liikennesuunnitelmalista[[i]] <- liikennesuunnitelmat2[((i-1)*6+1):(6*i)]};
liikennesuunnitelmalista <- unique(liikennesuunnitelmalista)
#
# Puretaan listarakenne unlist-komennolla:
liikennesuunnitelmalista <- unlist(liikennesuunnitelmalista)
#
# Eristetaan x- ja y-koordinaatit liikennesuunnitelmalista-muuttujasta:
#
apu.lkm <- length(liikennesuunnitelmalista)/6
polku.apu <- list(1:apu.lkm); for(i in 1:apu.lkm) {polku.apu[[i]] <- liikennesuunnitelmalista[((i-1)*6+2):((i-1)*6+5)]}

# Maaritetaan 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
#
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
#
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

+ Näytä koodi - Piilota koodi

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

Osallistuva_kaupunkisuunnittelu_-_Eracedu_2011
Helsingin seudun liikennemalli
Video liikennemallin ja liikennepelin esittelystä (Otavan opiston paja 8.9.2011)

Viitteet

Aiheeseen liittyviä tiedostoja

Joensuun keskustan liikennemalli J1

Sisällys

Rajaus

Määritelmä

Data

Kausaliteetti

Yksikkö

Kaava

Tulokset

Näytä tähänastiset ehdotukset

Katso myös

Viitteet

Aiheeseen liittyviä tiedostoja

Navigointivalikko