Ero sivun ”Hiekkalaatikko” versioiden välillä

Opasnet Suomista
Siirry navigaatioon Siirry hakuun
Ei muokkausyhteenvetoa
Rivi 1: Rivi 1:
Päivitetty
<p>Päivitetty
 
</p><p><span class="texhtml">123 + &#945; &#8722; 555 &#8722; 666</span>
<math>123+\alpha -555-666</math>
</p><p><br />
 
</p>
[[op_en:Sandbox]]
<h3> Terveysvaikutukset </h3>
 
<p><b>HUOM! Tällä hetkellä malli laskee ainoastaan murskausprosessin pölypäästöt ja niiden leviämisen 10-15 km:n säteellä olevaan väestöön. Mallia päivitetään jatkuvasti.</b>
 
</p><p>[vaihdetaan.kapsi.fi]
=== Terveysvaikutukset ===
</p><p><img src="/fi_wiki/images/c/cc/Harjoituskuva.png" _fck_mw_filename="Harjoituskuva.png" _fck_mw_width="200" _fck_mw_type="frame" alt="" class="fck_mw_frame fck_mw_right" />
 
</p><p><img src="/fi_wiki/images/0/06/Koala.jpg" _fck_mw_filename="Koala.jpg" _fck_mw_width="300" _fck_mw_height="600" _fck_mw_type="frame" alt="" class="fck_mw_frame fck_mw_right" />
'''HUOM! Tällä hetkellä malli laskee ainoastaan murskausprosessin pölypäästöt ja niiden leviämisen 10-15 km:n säteellä olevaan väestöön. Mallia päivitetään jatkuvasti.
</p><p><span class="fck_mw_special" _fck_mw_customtag="true" _fck_mw_tagname="rcode" variables="LA|Leveyspiiri|63.110577|LO|Pituuspiiri|27.735929|murskaus.maara|Murskattavan malmin määrä (Mg/a)|10000000|paasto.kerroin|Murskaukseen käytettävän prosessin päästökerroin (g/Mg)|72.6|N|Iteraatioiden määrä|100" graphics="1">fckLRlibrary(OpasnetBaseUtils)fckLRlibrary(ggplot2)fckLRfckLRearth.radius &lt;- 6372.8 # quadratic mean or root mean square approximation of the average great-circle fckLR # circumference derives a radius of about 6372.8 km (Wikipedia)fckLRcentral.angle &lt;- function(s.la, s.lo, f.la, f.lo) 2 * asin((sin((s.la - f.la) / 2)^2 + cos(s.la) * cos(f.la) * sin((s.lo - f.lo) / 2)^2)^0.5)fckLRfckLRdtheta.y &lt;- 1/earth.radius*180/pi # central angle increase per 1 kilometer north from a given point assuming no displacement on x axisfckLRdtheta.x &lt;- 2*asin(sin(1/(2*earth.radius))/cos(LA/180*pi))*180/pi # central angle increase per 1 kilometer east from a given point fckLR# - assuming no displacement on y axisfckLRfckLR# Populaatio datafckLRfckLRpop.locs &lt;- op_baseGetLocs(&quot;heande_base&quot;, &quot;Heande3182&quot;, apply.utf8 = FALSE)fckLRhead(pop.locs)fckLRpop.slice.la &lt;- pop.locs[pop.locs$ind == &quot;Latitude&quot;, &quot;loc_id&quot;][pop.locs[pop.locs$ind == &quot;Latitude&quot;, &quot;loc&quot;] &lt; LA + 10.5 * dtheta.y &amp; fckLR pop.locs[pop.locs$ind == &quot;Latitude&quot;, &quot;loc&quot;] &gt; LA - 10.5 * dtheta.y]fckLRpop.slice.lo.inverse &lt;- pop.locs[pop.locs$ind == &quot;Longitude&quot;, &quot;loc_id&quot;][pop.locs[pop.locs$ind == &quot;Longitude&quot;, &quot;loc&quot;] &gt; LO + 10.5 * dtheta.x | fckLR pop.locs[pop.locs$ind == &quot;Longitude&quot;, &quot;loc&quot;] &lt; LO - 10.5 * dtheta.x]fckLRfckLRpop &lt;- op_baseGetData(&quot;heande_base&quot;, &quot;Heande3182&quot;, include = pop.slice.la, exclude = pop.slice.lo.inverse)fckLRfckLRhead(pop)fckLRfckLRpop$Longitude &lt;- as.numeric(as.character(pop$Longitude))fckLRpop$Latitude &lt;- as.numeric(as.character(pop$Latitude))fckLRfckLRpop$LObin &lt;- cut(pop$Longitude, breaks = LO + ((-11:10) + 0.5 ) * dtheta.x)fckLRpop$LAbin &lt;- cut(pop$Latitude, breaks = LA + ((-11:10) + 0.5 ) * dtheta.y)fckLRfckLR# Pitoisuus datafckLRfckLRpitoisuus &lt;- function(n, paasto, L.matrix) { #, X_coord, Y_coord) {fckLR ID.list &lt;- tapply(1:nrow(L.matrix), L.matrix[,c(&quot;Kaupunki&quot;, &quot;Vuosi&quot;, &quot;Tyyppi&quot;)], list)fckLR ID.list.samples &lt;- sample(ID.list, n, replace = TRUE)fckLR ID.vec &lt;- unlist(ID.list.samples)fckLRprint(ID.vec)fckLRprint(ID.list)fckLR #c.matrix &lt;- pitoisuus(L.matrix, Paasto) #, X_coord, Y_coord)fckLR l.matrix &lt;- L.matrix[ID.vec,]fckLR l.matrix$obs &lt;- rep(1:n, each = length(ID.vec)/n)fckLRprint(head(l.matrix)) fckLR c.matrix &lt;- merge(l.matrix, paasto)fckLR c.matrix &lt;- model.frame(I(Paasto * k) ~., data = c.matrix)fckLR colnames(c.matrix)[1] &lt;- &quot;Pitoisuus&quot;fckLRprint(head(c.matrix))fckLR return(c.matrix)fckLR}fckLRfckLRPILTTI.matrix &lt;- op_baseGetData(&quot;heande_base&quot;, &quot;Heande3181&quot;)[,-c(1,2,9)] # unit: ugm^-3/Mga^-1fckLRfckLRPILTTI.matrix$dy &lt;- as.numeric(as.character(PILTTI.matrix$dy))fckLRPILTTI.matrix$dx &lt;- as.numeric(as.character(PILTTI.matrix$dx))fckLRfckLRcolnames(PILTTI.matrix)[colnames(PILTTI.matrix)==&quot;Result&quot;] &lt;- &quot;k&quot;fckLRfckLRhead(PILTTI.matrix)fckLRfckLRPaasto &lt;- data.frame(Paasto = murskaus.maara * paasto.kerroin / 1e6) # unit: Mga^-1fckLRfckLRhead(Paasto)fckLRfckLRC.matrix &lt;- pitoisuus(N, Paasto, PILTTI.matrix) # unit: ugm^-3fckLRNfckLRhead(C.matrix)fckLRfckLRC.matrix$LObin &lt;- cut(C.matrix$dx / 1000 * dtheta.x + LO, breaks = LO + ((-11:10) + 0.5 ) * dtheta.x)fckLRC.matrix$LAbin &lt;- cut(C.matrix$dy / 1000 * dtheta.y + LA, breaks = LA + ((-11:10) + 0.5 ) * dtheta.y)fckLRfckLR# YhdistysfckLRfckLRhead(C.matrix)fckLRfckLRpop.paasto &lt;- merge(C.matrix, pop[,-c(1,2,6)])fckLRfckLRpop.paasto.korjaus &lt;- data.frame(Pitoisuus = pop.paasto$Pitoisuus, Vaesto = pop.paasto$Result / N)fckLRfckLRhead(pop.paasto.korjaus)fckLRfckLRplot1 &lt;- ggplot(pop.paasto.korjaus, aes(x = Pitoisuus, weight = Vaesto)) + geom_histogram(binwidth = fckLR(max(pop.paasto.korjaus$Pitoisuus[pop.paasto.korjaus$Vaesto!=0]) - fckLRmin(pop.paasto.korjaus$Pitoisuus[pop.paasto.korjaus$Vaesto!=0]))/100) + fckLRxlim(min(pop.paasto.korjaus$Pitoisuus[pop.paasto.korjaus$Vaesto!=0]) - 0.000001, fckLRmax(pop.paasto.korjaus$Pitoisuus[pop.paasto.korjaus$Vaesto!=0]) + 0.000001)fckLRfckLRplot1 + geom_vline(xintercept = 40, colour = &quot;red&quot;) # OhjearvofckLRfckLRexposure.pop &lt;- tapply(pop.paasto$Pitoisuus * pop.paasto$Result, pop.paasto[,c(&quot;obs&quot;)], sum)fckLRfckLRbg.mort &lt;- 45182/5203826 # same values as used in PILTTIfckLRfckLRerf &lt;- 0.0097 # J. T. Tuomisto, A. Wilson, et al. Uncertainty in mortality response to airborne fine particulate matter... 2008fckLR# unit: 1/ugm^-3fckLRfckLRmort.out &lt;- erf * bg.mort * exposure.popfckLRfckLRqplot(mort.out, geom=&quot;density&quot;)fckLRfckLRcat(&quot;Odotusarvo kuolemille vuodessa:&quot;, mean(mort.out), &quot;\n&quot;)fckLRfckLRcat(&quot;Ohjearvon 40 ugm^-3 mukaisen altistusrajan ylitti&quot;, sum(pop.paasto.korjaus$Vaesto[pop.paasto.korjaus$Pitoisuus&gt;40]), &quot;asukasta.\n&quot;)fckLR</span>
 
</p>
[vaihdetaan.kapsi.fi]
<ul><li>Oletusarvot Siilinjärven Yaralle, yhdelle tonnille murskattua malmia vuodessa olettaen että murskaustapa on kuivaseulonta ilman avulla (suurin päästökerroin). Katso: <a _fcknotitle="true" href=":op fi:Metallimalmin murskausprosessin kokonais- (TSP) ja hengittyvien hiukkasten (PM10) päästökertoimet">:op fi:Metallimalmin murskausprosessin kokonais- (TSP) ja hengittyvien hiukkasten (PM10) päästökertoimet</a>.
 
</li><li>Havainnollisia lähtöarvojen muutoksia:
[[Image:Harjoituskuva.png|200px|frame|Hassu kuva]]
<ul><li> Luikonlahden koordinaatit (pienempi väestö kaivoksen ympärillä): latitude=62.936836, longitude=28.70749  
 
</li><li> Hienomurskaus kostealle malmille: päästökerroin 9.1 (oletus: kuiva malmi 72.6)
[[Tiedosto:koala.jpg|300x600px|frame|Hassuin kuva]]
</li></ul>
 
</li></ul>
<rcode variables = "LA|Leveyspiiri|63.110577|LO|Pituuspiiri|27.735929|murskaus.maara|Murskattavan malmin määrä (Mg/a)|10000000|paasto.kerroin|Murskaukseen käytettävän prosessin päästökerroin (g/Mg)|72.6|N|Iteraatioiden määrä|100" graphics = "1">
<h2> R-testi </h2>
library(OpasnetBaseUtils)
<p><span class="fck_mw_special" _fck_mw_customtag="true" _fck_mw_tagname="rcode" graphics="1" include="page:Funktioita_R-toolsiin|name:generic" variables="name:ala|default:900000|description:Jatropan viljelyala (ha)| name:n|default:10| name:divisions|description:Mitkä tekijät halua eritellä tuloksessa?|type:checkbox|options:'Katalyytin määrä';Katalyytin määrä;'Ikä';Ikä;'Kastelu';Kastelu;'Käytetty puristin';Käytetty puristin|default:'Kastelu'| name:divisions2|description:Minkä yhden tekijän halua eritellä kuvaajassa?|type:selection|options:'Katalyytin määrä';Katalyytin määrä;'Ikä';Ikä;'Kastelu';Kastelu;'Käytetty puristin';Käytetty puristin|default:'Kastelu'">fckLR######## Haetaan R-koodi generic sivulta Projektinhallinta. Sisältää funktiot dropall ja PTable.fckLR######## Ladataan tarvittavat paketitfckLRlibrary(OpasnetBaseUtils)fckLRlibrary(ggplot2)fckLRlibrary(xtable)fckLRfckLRprint(&quot;Haetaan tarvittava data Opasnet-kannasta&quot;)fckLRsaanto.siemenet &lt;- op_baseGetData(&quot;opasnet_base&quot;, &quot;Op_fi2633&quot;)[,-c(1,2,7)] # Jatropan siementen saanto viljelystäfckLRsaanto.öljy    &lt;- op_baseGetData(&quot;opasnet_base&quot;, &quot;Op_fi2634&quot;)[,-c(1,2,5)] # Öljyn saanto jatropan siemenistäfckLRsaanto.diesel  &lt;- op_baseGetData(&quot;opasnet_base&quot;, &quot;Op_fi2632&quot;)[,-c(1,2,5)] # Biodieselin saanto jatropaöljystäfckLRviljelyala     &lt;- op_baseGetData(&quot;opasnet_base&quot;, &quot;Op_fi2642&quot;)[,-c(1,2)] # Jatropan viljelyalueetfckLRpäästö.ilmasto  &lt;- op_baseGetData(&quot;opasnet_base&quot;, &quot;Op_fi2547&quot;)[,-c(1,2)] # Jatropan viljelyn ilmastovaikutuksetfckLRpäästö.sosiaali &lt;- op_baseGetData(&quot;opasnet_base&quot;, &quot;Op_fi2552&quot;)[,-c(1,2)] # Jatropan viljelyn sosiaaliset vaikutuksetfckLRpäästö.ekosyst  &lt;- op_baseGetData(&quot;opasnet_base&quot;, &quot;Op_fi2548&quot;)[,-c(1,2)] # Jatropan viljelyn ekosysteemivaikutuksetfckLRP               &lt;- op_baseGetData(&quot;opasnet_base&quot;, &quot;Op_fi2539&quot;)[,-c(1,2,7)] # Jatropan käyttö bioenergian lähteenäfckLRfckLRprint(&quot;Ajetaan malli&quot;)fckLRfckLR### Muutetaan sarakkeiden nimet sopiviksi yhdistämistä varten.fckLRcolnames(saanto.siemenet)[4] &lt;- &quot;siemenet&quot;fckLRcolnames(saanto.öljy)[2] &lt;- &quot;öljy&quot;fckLRcolnames(saanto.diesel)[2] &lt;- &quot;diesel&quot;fckLRfckLR## Yhdistetään tiedot toisiinsa yhdeksi data.frameksi. Lasketaan saanto.fckLRsaanto &lt;- merge(saanto.siemenet, saanto.öljy)fckLRsaanto &lt;- merge(saanto, saanto.diesel)fckLRsaanto[,9] &lt;- saanto$siemenet * saanto$öljy * saanto$diesel * alafckLRcolnames(saanto)[9] &lt;- &quot;saanto (kg/a)&quot;fckLRfckLR## Muutetaan tulos jakaumaksi Monte Carlolla.fckLRP &lt;- PTable(P, n)fckLRsaanto &lt;- merge(P, saanto)fckLRfckLR## Lasketaan tulostaulu.fckLRif(length(divisions)&gt;1) divisions &lt;- as.list(saanto[, divisions]) else divisions &lt;- saanto[, divisions]fckLRout1 &lt;- as.data.frame(as.table(tapply(saanto[, 10], divisions, mean))) fckLRout1 &lt;- dropall(out1[!is.na(out1$Freq), ])fckLRfckLRprint(xtable(out1), type = 'html')fckLRfckLR## Lasketaan tuloskuvaaja.fckLRout2 &lt;- as.data.frame(as.table(tapply(saanto[, 10], list(saanto[, divisions2], saanto$obs), mean))) fckLRout2 &lt;- dropall(out2[!is.na(out2$Freq), ])fckLRggplot(out2, aes(x = Freq, weight = 1, fill = Var1)) +geom_density() fckLR## Jostain syystä vain osa kuvista piirtyy oikein, riippuen mitä parametreja valitaan. En ymmärrä syytä.fckLR</span>
library(ggplot2)
</p><p><br />
 
<span class="fck_mw_template">{{bluebox|fckLR==Komia loota==fckLR* sininenfckLRfckLRon komia...fckLR}}</span>
earth.radius <- 6372.8 # quadratic mean or root mean square approximation of the average great-circle
</p><p><span class="fck_mw_special" _fck_mw_customtag="true" _fck_mw_tagname="t2b" index="Year,Country" unit="#" obs="Mortality">fckLR2001|Finland|1001fckLR2002|Finland|judanssfckLR2001|Sweden|900fckLR2002|Sweden|800fckLR</span>
# circumference derives a radius of about 6372.8 km (Wikipedia)
</p><p><span class="fck_mw_template">{{greenbox|fckLRJEPJEJPKEPKEfckLRfckLRJOOfckLR}}</span>
central.angle <- function(s.la, s.lo, f.la, f.lo) 2 * asin((sin((s.la - f.la) / 2)^2 + cos(s.la) * cos(f.la) * sin((s.lo - f.lo) / 2)^2)^0.5)
</p><p>fwae
 
</p><p>JEPULISTA
dtheta.y <- 1/earth.radius*180/pi # central angle increase per 1 kilometer north from a given point assuming no displacement on x axis
<span class="fck_mw_special" _fck_mw_customtag="true" _fck_mw_tagname="dpl">fckLRcategory = THL:n julkaisuja vuonna 2010fckLRmode = orderedfckLRinclude = {julkaisu}fckLRordermethod=titlefckLRformat   = ,\n&lt;big&gt;'''[[%PAGE%|%TITLE%]]'''&lt;/big&gt;,,fckLRnotcategory = glossaryfckLRorder = ascendingfckLR</span>
dtheta.x <- 2*asin(sin(1/(2*earth.radius))/cos(LA/180*pi))*180/pi # central angle increase per 1 kilometer east from a given point  
</p><p><br />
# - assuming no displacement on y axis
<span class="fck_mw_template">{{budjettirajapintafckLR| työpaketit        = 'TP1';TP1;'TP2';TP2;'TP3';TP3;'TP4';TP4;'TP5';TP5fckLR| vuodet            = '2012';2012;'2013';2013;'2014;2014fckLR| sivu              = Op_fi2682fckLR| rahoittaja        = STMfckLR| projekti          = TekaisufckLR| työpaketti        = TP1fckLR| työpaketti.add    = TP1fckLR| rahoittaja.add    = STMfckLR| työpaketit_default = 'TP1';'TP2';'TP3';'TP5'fckLR| rahoittaja_default = STMfckLR}}</span>
 
</p><a _fcknotitle="true" href="Category:Testi">Testi</a>
# Populaatio data
<a href="op en:Sandbox">op en:Sandbox</a>
 
pop.locs <- op_baseGetLocs("heande_base", "Heande3182", apply.utf8 = FALSE)
head(pop.locs)
pop.slice.la <- pop.locs[pop.locs$ind == "Latitude", "loc_id"][pop.locs[pop.locs$ind == "Latitude", "loc"] < LA + 10.5 * dtheta.y &  
pop.locs[pop.locs$ind == "Latitude", "loc"] > LA - 10.5 * dtheta.y]
pop.slice.lo.inverse <- pop.locs[pop.locs$ind == "Longitude", "loc_id"][pop.locs[pop.locs$ind == "Longitude", "loc"] > LO + 10.5 * dtheta.x |  
pop.locs[pop.locs$ind == "Longitude", "loc"] < LO - 10.5 * dtheta.x]
 
pop <- op_baseGetData("heande_base", "Heande3182", include = pop.slice.la, exclude = pop.slice.lo.inverse)
 
head(pop)
 
pop$Longitude <- as.numeric(as.character(pop$Longitude))
pop$Latitude <- as.numeric(as.character(pop$Latitude))
 
pop$LObin <- cut(pop$Longitude, breaks = LO + ((-11:10) + 0.5 ) * dtheta.x)
pop$LAbin <- cut(pop$Latitude, breaks = LA + ((-11:10) + 0.5 ) * dtheta.y)
 
# Pitoisuus data
 
pitoisuus <- function(n, paasto, L.matrix) { #, X_coord, Y_coord) {
ID.list <- tapply(1:nrow(L.matrix), L.matrix[,c("Kaupunki", "Vuosi", "Tyyppi")], list)
ID.list.samples <- sample(ID.list, n, replace = TRUE)
ID.vec <- unlist(ID.list.samples)
print(ID.vec)
print(ID.list)
#c.matrix <- pitoisuus(L.matrix, Paasto) #, X_coord, Y_coord)
l.matrix <- L.matrix[ID.vec,]
l.matrix$obs <- rep(1:n, each = length(ID.vec)/n)
print(head(l.matrix))
c.matrix <- merge(l.matrix, paasto)
c.matrix <- model.frame(I(Paasto * k) ~., data = c.matrix)
colnames(c.matrix)[1] <- "Pitoisuus"
print(head(c.matrix))
return(c.matrix)
}
 
PILTTI.matrix <- op_baseGetData("heande_base", "Heande3181")[,-c(1,2,9)] # unit: ugm^-3/Mga^-1
 
PILTTI.matrix$dy <- as.numeric(as.character(PILTTI.matrix$dy))
PILTTI.matrix$dx <- as.numeric(as.character(PILTTI.matrix$dx))
 
colnames(PILTTI.matrix)[colnames(PILTTI.matrix)=="Result"] <- "k"
 
head(PILTTI.matrix)
 
Paasto <- data.frame(Paasto = murskaus.maara * paasto.kerroin / 1e6) # unit: Mga^-1
 
head(Paasto)
 
C.matrix <- pitoisuus(N, Paasto, PILTTI.matrix) # unit: ugm^-3
N
head(C.matrix)
 
C.matrix$LObin <- cut(C.matrix$dx / 1000 * dtheta.x + LO, breaks = LO + ((-11:10) + 0.5 ) * dtheta.x)
C.matrix$LAbin <- cut(C.matrix$dy / 1000 * dtheta.y + LA, breaks = LA + ((-11:10) + 0.5 ) * dtheta.y)
 
# Yhdistys
 
head(C.matrix)
 
pop.paasto <- merge(C.matrix, pop[,-c(1,2,6)])
 
pop.paasto.korjaus <- data.frame(Pitoisuus = pop.paasto$Pitoisuus, Vaesto = pop.paasto$Result / N)
 
head(pop.paasto.korjaus)
 
plot1 <- ggplot(pop.paasto.korjaus, aes(x = Pitoisuus, weight = Vaesto)) + geom_histogram(binwidth =  
(max(pop.paasto.korjaus$Pitoisuus[pop.paasto.korjaus$Vaesto!=0]) -  
min(pop.paasto.korjaus$Pitoisuus[pop.paasto.korjaus$Vaesto!=0]))/100) +  
xlim(min(pop.paasto.korjaus$Pitoisuus[pop.paasto.korjaus$Vaesto!=0]) - 0.000001,  
max(pop.paasto.korjaus$Pitoisuus[pop.paasto.korjaus$Vaesto!=0]) + 0.000001)
 
plot1 + geom_vline(xintercept = 40, colour = "red") # Ohjearvo
 
exposure.pop <- tapply(pop.paasto$Pitoisuus * pop.paasto$Result, pop.paasto[,c("obs")], sum)
 
bg.mort <- 45182/5203826 # same values as used in PILTTI
 
erf <- 0.0097 # J. T. Tuomisto, A. Wilson, et al. Uncertainty in mortality response to airborne fine particulate matter... 2008
# unit: 1/ugm^-3
 
mort.out <- erf * bg.mort * exposure.pop
 
qplot(mort.out, geom="density")
 
cat("Odotusarvo kuolemille vuodessa:", mean(mort.out), "\n")
 
cat("Ohjearvon 40 ugm^-3 mukaisen altistusrajan ylitti", sum(pop.paasto.korjaus$Vaesto[pop.paasto.korjaus$Pitoisuus>40]), "asukasta.\n")
</rcode>
 
*Oletusarvot Siilinjärven Yaralle, yhdelle tonnille murskattua malmia vuodessa olettaen että murskaustapa on kuivaseulonta ilman avulla (suurin päästökerroin). Katso: [[:op_fi:Metallimalmin murskausprosessin kokonais- (TSP) ja hengittyvien hiukkasten (PM10) päästökertoimet]].
*Havainnollisia lähtöarvojen muutoksia:
** Luikonlahden koordinaatit (pienempi väestö kaivoksen ympärillä): latitude=62.936836, longitude=28.70749  
** Hienomurskaus kostealle malmille: päästökerroin 9.1 (oletus: kuiva malmi 72.6)
 
== R-testi ==
 
<rcode
graphics="1"  
include="page:Funktioita_R-toolsiin|name:generic"  
variables="name:ala|default:900000|description:Jatropan viljelyala (ha)|
name:n|default:10|
name:divisions|description:Mitkä tekijät halua eritellä tuloksessa?|type:checkbox|options:'Katalyytin määrä';Katalyytin määrä;'Ikä';Ikä;'Kastelu';Kastelu;'Käytetty puristin';Käytetty puristin|default:'Kastelu'|
name:divisions2|description:Minkä yhden tekijän halua eritellä kuvaajassa?|type:selection|options:'Katalyytin määrä';Katalyytin määrä;'Ikä';Ikä;'Kastelu';Kastelu;'Käytetty puristin';Käytetty puristin|default:'Kastelu'
">
######## Haetaan R-koodi generic sivulta Projektinhallinta. Sisältää funktiot dropall ja PTable.
######## Ladataan tarvittavat paketit
library(OpasnetBaseUtils)
library(ggplot2)
library(xtable)
 
print("Haetaan tarvittava data Opasnet-kannasta")
saanto.siemenet <- op_baseGetData("opasnet_base", "Op_fi2633")[,-c(1,2,7)] # Jatropan siementen saanto viljelystä
saanto.öljy    <- op_baseGetData("opasnet_base", "Op_fi2634")[,-c(1,2,5)] # Öljyn saanto jatropan siemenistä
saanto.diesel  <- op_baseGetData("opasnet_base", "Op_fi2632")[,-c(1,2,5)] # Biodieselin saanto jatropaöljystä
viljelyala     <- op_baseGetData("opasnet_base", "Op_fi2642")[,-c(1,2)] # Jatropan viljelyalueet
päästö.ilmasto  <- op_baseGetData("opasnet_base", "Op_fi2547")[,-c(1,2)] # Jatropan viljelyn ilmastovaikutukset
päästö.sosiaali <- op_baseGetData("opasnet_base", "Op_fi2552")[,-c(1,2)] # Jatropan viljelyn sosiaaliset vaikutukset
päästö.ekosyst  <- op_baseGetData("opasnet_base", "Op_fi2548")[,-c(1,2)] # Jatropan viljelyn ekosysteemivaikutukset
P               <- op_baseGetData("opasnet_base", "Op_fi2539")[,-c(1,2,7)] # Jatropan käyttö bioenergian lähteenä
 
print("Ajetaan malli")
 
### Muutetaan sarakkeiden nimet sopiviksi yhdistämistä varten.
colnames(saanto.siemenet)[4] <- "siemenet"
colnames(saanto.öljy)[2] <- "öljy"
colnames(saanto.diesel)[2] <- "diesel"
 
## Yhdistetään tiedot toisiinsa yhdeksi data.frameksi. Lasketaan saanto.
saanto <- merge(saanto.siemenet, saanto.öljy)
saanto <- merge(saanto, saanto.diesel)
saanto[,9] <- saanto$siemenet * saanto$öljy * saanto$diesel * ala
colnames(saanto)[9] <- "saanto (kg/a)"
 
## Muutetaan tulos jakaumaksi Monte Carlolla.
P <- PTable(P, n)
saanto <- merge(P, saanto)
 
## Lasketaan tulostaulu.
if(length(divisions)>1) divisions <- as.list(saanto[, divisions]) else divisions <- saanto[, divisions]
out1 <- as.data.frame(as.table(tapply(saanto[, 10], divisions, mean)))  
out1 <- dropall(out1[!is.na(out1$Freq), ])
 
print(xtable(out1), type = 'html')
 
## Lasketaan tuloskuvaaja.
out2 <- as.data.frame(as.table(tapply(saanto[, 10], list(saanto[, divisions2], saanto$obs), mean)))  
out2 <- dropall(out2[!is.na(out2$Freq), ])
ggplot(out2, aes(x = Freq, weight = 1, fill = Var1)) +geom_density()  
## Jostain syystä vain osa kuvista piirtyy oikein, riippuen mitä parametreja valitaan. En ymmärrä syytä.
</rcode>
 
 
{{bluebox|
==Komia loota==
* sininen
 
on komia...
}}
 
<t2b index="Year,Country" unit="#" obs="Mortality">
2001|Finland|1001
2002|Finland|judanss
2001|Sweden|900
2002|Sweden|800
</t2b>
 
{{greenbox|
JEPJEJPKEPKE
 
JOO
}}
 
fwae
 
JEPULISTA
<dpl>
category = THL:n julkaisuja vuonna 2010
mode = ordered
include = {julkaisu}
ordermethod=title
format   = ,\n<big>'''[[%PAGE%|%TITLE%]]'''</big>,,
notcategory = glossary
order = ascending
</dpl>
[[Luokka:testi]]
 
 
{{budjettirajapinta
| työpaketit        = 'TP1';TP1;'TP2';TP2;'TP3';TP3;'TP4';TP4;'TP5';TP5
| vuodet            = '2012';2012;'2013';2013;'2014;2014
| sivu              = Op_fi2682
| rahoittaja        = STM
| projekti          = Tekaisu
| työpaketti        = TP1
| työpaketti.add    = TP1
| rahoittaja.add    = STM
| työpaketit_default = 'TP1';'TP2';'TP3';'TP5'
| rahoittaja_default = STM
}}

Versio 12. tammikuuta 2012 kello 11.50

Päivitetty

123 + α − 555 − 666


Terveysvaikutukset

HUOM! Tällä hetkellä malli laskee ainoastaan murskausprosessin pölypäästöt ja niiden leviämisen 10-15 km:n säteellä olevaan väestöön. Mallia päivitetään jatkuvasti.

[vaihdetaan.kapsi.fi]

<img src="/fi_wiki/images/c/cc/Harjoituskuva.png" _fck_mw_filename="Harjoituskuva.png" _fck_mw_width="200" _fck_mw_type="frame" alt="" class="fck_mw_frame fck_mw_right" />

<img src="/fi_wiki/images/0/06/Koala.jpg" _fck_mw_filename="Koala.jpg" _fck_mw_width="300" _fck_mw_height="600" _fck_mw_type="frame" alt="" class="fck_mw_frame fck_mw_right" />

fckLRlibrary(OpasnetBaseUtils)fckLRlibrary(ggplot2)fckLRfckLRearth.radius <- 6372.8 # quadratic mean or root mean square approximation of the average great-circle fckLR # circumference derives a radius of about 6372.8 km (Wikipedia)fckLRcentral.angle <- function(s.la, s.lo, f.la, f.lo) 2 * asin((sin((s.la - f.la) / 2)^2 + cos(s.la) * cos(f.la) * sin((s.lo - f.lo) / 2)^2)^0.5)fckLRfckLRdtheta.y <- 1/earth.radius*180/pi # central angle increase per 1 kilometer north from a given point assuming no displacement on x axisfckLRdtheta.x <- 2*asin(sin(1/(2*earth.radius))/cos(LA/180*pi))*180/pi # central angle increase per 1 kilometer east from a given point fckLR# - assuming no displacement on y axisfckLRfckLR# Populaatio datafckLRfckLRpop.locs <- op_baseGetLocs("heande_base", "Heande3182", apply.utf8 = FALSE)fckLRhead(pop.locs)fckLRpop.slice.la <- pop.locs[pop.locs$ind == "Latitude", "loc_id"][pop.locs[pop.locs$ind == "Latitude", "loc"] < LA + 10.5 * dtheta.y & fckLR pop.locs[pop.locs$ind == "Latitude", "loc"] > LA - 10.5 * dtheta.y]fckLRpop.slice.lo.inverse <- pop.locs[pop.locs$ind == "Longitude", "loc_id"][pop.locs[pop.locs$ind == "Longitude", "loc"] > LO + 10.5 * dtheta.x | fckLR pop.locs[pop.locs$ind == "Longitude", "loc"] < LO - 10.5 * dtheta.x]fckLRfckLRpop <- op_baseGetData("heande_base", "Heande3182", include = pop.slice.la, exclude = pop.slice.lo.inverse)fckLRfckLRhead(pop)fckLRfckLRpop$Longitude <- as.numeric(as.character(pop$Longitude))fckLRpop$Latitude <- as.numeric(as.character(pop$Latitude))fckLRfckLRpop$LObin <- cut(pop$Longitude, breaks = LO + ((-11:10) + 0.5 ) * dtheta.x)fckLRpop$LAbin <- cut(pop$Latitude, breaks = LA + ((-11:10) + 0.5 ) * dtheta.y)fckLRfckLR# Pitoisuus datafckLRfckLRpitoisuus <- function(n, paasto, L.matrix) { #, X_coord, Y_coord) {fckLR ID.list <- tapply(1:nrow(L.matrix), L.matrix[,c("Kaupunki", "Vuosi", "Tyyppi")], list)fckLR ID.list.samples <- sample(ID.list, n, replace = TRUE)fckLR ID.vec <- unlist(ID.list.samples)fckLRprint(ID.vec)fckLRprint(ID.list)fckLR #c.matrix <- pitoisuus(L.matrix, Paasto) #, X_coord, Y_coord)fckLR l.matrix <- L.matrix[ID.vec,]fckLR l.matrix$obs <- rep(1:n, each = length(ID.vec)/n)fckLRprint(head(l.matrix)) fckLR c.matrix <- merge(l.matrix, paasto)fckLR c.matrix <- model.frame(I(Paasto * k) ~., data = c.matrix)fckLR colnames(c.matrix)[1] <- "Pitoisuus"fckLRprint(head(c.matrix))fckLR return(c.matrix)fckLR}fckLRfckLRPILTTI.matrix <- op_baseGetData("heande_base", "Heande3181")[,-c(1,2,9)] # unit: ugm^-3/Mga^-1fckLRfckLRPILTTI.matrix$dy <- as.numeric(as.character(PILTTI.matrix$dy))fckLRPILTTI.matrix$dx <- as.numeric(as.character(PILTTI.matrix$dx))fckLRfckLRcolnames(PILTTI.matrix)[colnames(PILTTI.matrix)=="Result"] <- "k"fckLRfckLRhead(PILTTI.matrix)fckLRfckLRPaasto <- data.frame(Paasto = murskaus.maara * paasto.kerroin / 1e6) # unit: Mga^-1fckLRfckLRhead(Paasto)fckLRfckLRC.matrix <- pitoisuus(N, Paasto, PILTTI.matrix) # unit: ugm^-3fckLRNfckLRhead(C.matrix)fckLRfckLRC.matrix$LObin <- cut(C.matrix$dx / 1000 * dtheta.x + LO, breaks = LO + ((-11:10) + 0.5 ) * dtheta.x)fckLRC.matrix$LAbin <- cut(C.matrix$dy / 1000 * dtheta.y + LA, breaks = LA + ((-11:10) + 0.5 ) * dtheta.y)fckLRfckLR# YhdistysfckLRfckLRhead(C.matrix)fckLRfckLRpop.paasto <- merge(C.matrix, pop[,-c(1,2,6)])fckLRfckLRpop.paasto.korjaus <- data.frame(Pitoisuus = pop.paasto$Pitoisuus, Vaesto = pop.paasto$Result / N)fckLRfckLRhead(pop.paasto.korjaus)fckLRfckLRplot1 <- ggplot(pop.paasto.korjaus, aes(x = Pitoisuus, weight = Vaesto)) + geom_histogram(binwidth = fckLR(max(pop.paasto.korjaus$Pitoisuus[pop.paasto.korjaus$Vaesto!=0]) - fckLRmin(pop.paasto.korjaus$Pitoisuus[pop.paasto.korjaus$Vaesto!=0]))/100) + fckLRxlim(min(pop.paasto.korjaus$Pitoisuus[pop.paasto.korjaus$Vaesto!=0]) - 0.000001, fckLRmax(pop.paasto.korjaus$Pitoisuus[pop.paasto.korjaus$Vaesto!=0]) + 0.000001)fckLRfckLRplot1 + geom_vline(xintercept = 40, colour = "red") # OhjearvofckLRfckLRexposure.pop <- tapply(pop.paasto$Pitoisuus * pop.paasto$Result, pop.paasto[,c("obs")], sum)fckLRfckLRbg.mort <- 45182/5203826 # same values as used in PILTTIfckLRfckLRerf <- 0.0097 # J. T. Tuomisto, A. Wilson, et al. Uncertainty in mortality response to airborne fine particulate matter... 2008fckLR# unit: 1/ugm^-3fckLRfckLRmort.out <- erf * bg.mort * exposure.popfckLRfckLRqplot(mort.out, geom="density")fckLRfckLRcat("Odotusarvo kuolemille vuodessa:", mean(mort.out), "\n")fckLRfckLRcat("Ohjearvon 40 ugm^-3 mukaisen altistusrajan ylitti", sum(pop.paasto.korjaus$Vaesto[pop.paasto.korjaus$Pitoisuus>40]), "asukasta.\n")fckLR

  • Oletusarvot Siilinjärven Yaralle, yhdelle tonnille murskattua malmia vuodessa olettaen että murskaustapa on kuivaseulonta ilman avulla (suurin päästökerroin). Katso: <a _fcknotitle="true" href=":op fi:Metallimalmin murskausprosessin kokonais- (TSP) ja hengittyvien hiukkasten (PM10) päästökertoimet">:op fi:Metallimalmin murskausprosessin kokonais- (TSP) ja hengittyvien hiukkasten (PM10) päästökertoimet</a>.
  • Havainnollisia lähtöarvojen muutoksia:
    • Luikonlahden koordinaatit (pienempi väestö kaivoksen ympärillä): latitude=62.936836, longitude=28.70749
    • Hienomurskaus kostealle malmille: päästökerroin 9.1 (oletus: kuiva malmi 72.6)

R-testi

fckLR######## Haetaan R-koodi generic sivulta Projektinhallinta. Sisältää funktiot dropall ja PTable.fckLR######## Ladataan tarvittavat paketitfckLRlibrary(OpasnetBaseUtils)fckLRlibrary(ggplot2)fckLRlibrary(xtable)fckLRfckLRprint("Haetaan tarvittava data Opasnet-kannasta")fckLRsaanto.siemenet <- op_baseGetData("opasnet_base", "Op_fi2633")[,-c(1,2,7)] # Jatropan siementen saanto viljelystäfckLRsaanto.öljy <- op_baseGetData("opasnet_base", "Op_fi2634")[,-c(1,2,5)] # Öljyn saanto jatropan siemenistäfckLRsaanto.diesel <- op_baseGetData("opasnet_base", "Op_fi2632")[,-c(1,2,5)] # Biodieselin saanto jatropaöljystäfckLRviljelyala <- op_baseGetData("opasnet_base", "Op_fi2642")[,-c(1,2)] # Jatropan viljelyalueetfckLRpäästö.ilmasto <- op_baseGetData("opasnet_base", "Op_fi2547")[,-c(1,2)] # Jatropan viljelyn ilmastovaikutuksetfckLRpäästö.sosiaali <- op_baseGetData("opasnet_base", "Op_fi2552")[,-c(1,2)] # Jatropan viljelyn sosiaaliset vaikutuksetfckLRpäästö.ekosyst <- op_baseGetData("opasnet_base", "Op_fi2548")[,-c(1,2)] # Jatropan viljelyn ekosysteemivaikutuksetfckLRP <- op_baseGetData("opasnet_base", "Op_fi2539")[,-c(1,2,7)] # Jatropan käyttö bioenergian lähteenäfckLRfckLRprint("Ajetaan malli")fckLRfckLR### Muutetaan sarakkeiden nimet sopiviksi yhdistämistä varten.fckLRcolnames(saanto.siemenet)[4] <- "siemenet"fckLRcolnames(saanto.öljy)[2] <- "öljy"fckLRcolnames(saanto.diesel)[2] <- "diesel"fckLRfckLR## Yhdistetään tiedot toisiinsa yhdeksi data.frameksi. Lasketaan saanto.fckLRsaanto <- merge(saanto.siemenet, saanto.öljy)fckLRsaanto <- merge(saanto, saanto.diesel)fckLRsaanto[,9] <- saanto$siemenet * saanto$öljy * saanto$diesel * alafckLRcolnames(saanto)[9] <- "saanto (kg/a)"fckLRfckLR## Muutetaan tulos jakaumaksi Monte Carlolla.fckLRP <- PTable(P, n)fckLRsaanto <- merge(P, saanto)fckLRfckLR## Lasketaan tulostaulu.fckLRif(length(divisions)>1) divisions <- as.list(saanto[, divisions]) else divisions <- saanto[, divisions]fckLRout1 <- as.data.frame(as.table(tapply(saanto[, 10], divisions, mean))) fckLRout1 <- dropall(out1[!is.na(out1$Freq), ])fckLRfckLRprint(xtable(out1), type = 'html')fckLRfckLR## Lasketaan tuloskuvaaja.fckLRout2 <- as.data.frame(as.table(tapply(saanto[, 10], list(saanto[, divisions2], saanto$obs), mean))) fckLRout2 <- dropall(out2[!is.na(out2$Freq), ])fckLRggplot(out2, aes(x = Freq, weight = 1, fill = Var1)) +geom_density() fckLR## Jostain syystä vain osa kuvista piirtyy oikein, riippuen mitä parametreja valitaan. En ymmärrä syytä.fckLR


{{{1}}}

fckLR2001|Finland|1001fckLR2002|Finland|judanssfckLR2001|Sweden|900fckLR2002|Sweden|800fckLR

fckLRJEPJEJPKEPKEfckLRfckLRJOOfckLR

fwae

JEPULISTA

fckLRcategory = THL:n julkaisuja vuonna 2010fckLRmode = orderedfckLRinclude = {julkaisu}fckLRordermethod=titlefckLRformat = ,\n<big>%TITLE%</big>,,fckLRnotcategory = glossaryfckLRorder = ascendingfckLR


Malline:BudjettirajapintafckLR

<a _fcknotitle="true" href="Category:Testi">Testi</a>

<a href="op en:Sandbox">op en:Sandbox</a>