Ero sivun ”Ympäristöterveysindikaattori” versioiden välillä

Opasnet Suomista
Siirry navigaatioon Siirry hakuun
(→‎Syykaaviot: yhdistelmäkoodit, jossa ei tarvita rvestiä)
Rivi 104: Rivi 104:
   wiki="opasnet_fi",
   wiki="opasnet_fi",
   unzip="meta.csv",
   unzip="meta.csv",
   sep=",",header=TRUE
   sep=",",header=TRUE,stringsAsFactors=FALSE
)  
)  


out <- list()
out <- list()
for(i in 1:nrow(meta)) {
for(i in 1:nrow(meta)) {
   temp  <- cbind(
   temp  <- opasnet.csv(
    opasnet.csv(
    "3/3e/N%C3%A4kemysverkkojen_tietotauluja.zip",
      "3/3e/N%C3%A4kemysverkkojen_tietotauluja.zip",
    wiki="opasnet_fi",
      wiki="opasnet_fi",
    unzip=gsub("[Öö]","o",gsub("[ÄÅäå]","a",paste0(meta$Ilmio[i],".csv"))),
      unzip=gsub("[Öö]","o",gsub("[ÄÅäå]","a",paste0(meta$Ilmio[i],".csv"))),
    sep=",",header=TRUE,stringsAsFactors=FALSE
      sep=",",header=TRUE
    ),
    Oldid = meta$Id[i]
   )
   )
   for(j in 1:ncol(temp)) temp[[j]] <- as.character(temp[[j]])
   temp$Oldid = paste(meta$Id[i],1:nrow(temp),sep=".")
for(j in 1:ncol(temp)) temp[[j]] <- as.character(temp[[j]])
 
   # Convert structural names to English
   # Convert structural names to English
   colnames(temp)[colnames(temp)=="Lyhenne"] <- "label" # Columns defined by DiagrammeR start with small letter
   colnames(temp)[colnames(temp)=="Lyhenne"] <- "label" # Columns defined by DiagrammeR start with small letter
Rivi 126: Rivi 125:
   colnames(temp)[colnames(temp) %in% c("Objekti","Kohde")] <- "Object"
   colnames(temp)[colnames(temp) %in% c("Objekti","Kohde")] <- "Object"
   colnames(temp)[colnames(temp)=="Kuvaus"] <- "Description"
   colnames(temp)[colnames(temp)=="Kuvaus"] <- "Description"
  temp$Object <- tolower(temp$Object)
   if(!"label" %in% colnames(temp)) temp$label <- NA
   if(!"label" %in% colnames(temp)) temp$label <- NA
   temp$label <- ifelse(is.na(temp$label), substr(temp$Item,1,50), temp$label)
   temp$label <- ifelse(is.na(temp$label), substr(temp$Item,1,50), temp$label)
Rivi 132: Rivi 130:
}
}


out[[5]] <- splizzeria(out[[5]], spliz = c("Ulottuvuus","Osiotyyppi","JHS"), split = "/") # HYTE
#  Table-specific adjustments
out[[6]] <- splizzeria(out[[6]], spliz = c("JHS"), split = ",") # LAPE
 
out[[5]] <- splizzeria(out[[5]], cols = c("Ulottuvuus","Osiotyyppi","JHS.luokka"), split = "/") # HYTE
out[[6]] <- splizzeria(out[[6]], cols = c("JHS.luokka"), split = ",") # LAPE
#  temp$Object <- tolower(temp$Object) # Tämä ei haluta tehdä kaikille. mutta mille?


d3 <- data.frame()
# Aikuisten lihavuuden säätöjä
for(i in (1:nrow(meta))[meta$Tyyppi=="sotearv"]) d3 <- rbind(d3, out[[i]])
#for(i in 1:4) out[[7]][[i]] <- tolower(out[[7]][[i]])


# HYTE JA LAPE ELI SOTEARV
# HYTE JA LAPE ELI SOTEARV
d3 <- data.frame()
for(i in (1:nrow(meta))[meta$Tyyppi=="sotearv"]) {
  if(nrow(d3)==0) d3 <- out[[i]] else d3 <- orbind(d3, out[[i]])
}


d3 <- orbind(orbind(orbind(
d3 <- orbind(orbind(orbind(
   data.frame(
   data.frame(
     Oldid = d3$Oldid,
     Oldid = d3$Oldid,
     type = paste(d3$Tehtäväkokonaisuus, "indikaattori",sep="-"),
     type = paste(d3$Tehtavakokonaisuus, "indikaattori",sep="-"),
     Item = d3$Item,
     Item = d3$Nimi,
     Relation = "ulottuvuus",
     Relation = "ulottuvuus",
     Object = d3$Ulottuvuus,
     Object = d3$Ulottuvuus,
     URL = ifelse(d3$Sotkanetid %in% c("ei","e"), NA, paste(sotkanet, substr(d3$Sotkanetid,1,4), sep="")),
     URL = ifelse(
     Description = d3$Perustelut,
      is.na(as.numeric(substr(d3$Sotkanet.id,1,4))),
     label = substr(d3$Item,1,25)
      NA,
      paste0(sotkanet, substr(d3$Sotkanet.id,1,4))
    ),
     Description = d3$Ryhman.perustelut,
     label = ifelse(is.na(d3$label),substr(d3$Item,1,30),d3$label),
    stringsAsFactors = FALSE
   ),
   ),
   data.frame(
   data.frame(
     Item = d3$Item,
     Item = d3$Nimi,
     Relation = "osiotyyppi",
     Relation = "osiotyyppi",
     Object = d3$Osiotyyppi
     Object = d3$Osiotyyppi,
    stringsAsFactors = FALSE
   )),
   )),
   data.frame(
   data.frame(
     Item = d3$Item,
     Item = d3$Nimi,
     Relation = "discussed in",
     Relation = "discussed in",
     Object = d3$Tietolähde
     Object = d3$Tietolahde,
    stringsAsFactors = FALSE
   )),
   )),
   data.frame(
   data.frame(
     Item = d3$Item,
     Item = d3$Nimi,
     Relation = "JHS-luokka",
     Relation = "JHS-luokka",
     Object = d3$JHS
     Object = d3$JHS.luokka,
    stringsAsFactors = FALSE
   )
   )
)  
)  
Rivi 171: Rivi 185:


d2 <- data.frame()
d2 <- data.frame()
for(i in (1:nrow(meta))[meta$Tyyppi=="oletus"]) d2 <- rbind(d2, out[[i]])
for(i in (1:nrow(meta))[meta$Tyyppi=="oletus"]) {
  if(nrow(d2)==0) d2 <- out[[i]] else d2 <- orbind(d2, out[[i]])
}


for(i in c("type","Relation","Object")) {  
#' @title fillprev fills empty cells in a data.frame by using content from the previous row.
  for(j in 2:nrow(d2)) {
#' @param df data.frame to be filled
    if(d2[j,i] %in% c("", NA)) d2[j,i] <- d2[j-1,i]
#' @param cols vector of column names or positions to be filled.
#' @return Returns a data.frame with the same shape as df.
fillprev <- function(df, cols) {
  out <- df
  for(i in cols) {  
    for(j in 2:nrow(out)) {
      if(out[j,i] %in% c("", NA)) out[j,i] <- out[j-1,i]
    }
   }
   }
  return(out)
}
}
d2 <- splizzeria(d2, spliz = "Objekti", split=",")


# Aikuisten lihavuuden säätöjä
d2 <- fillprev(d2, cols=c("type","Relation","Object"))
# for(i in 1:4) d4[[i]] <- tolower(d4[[i]]) # Tarvitaanko tätä?
d2 <- splizzeria(d2, cols="Object", split=",")
d2$URL <- ifelse(is.na(as.numeric(substr(d4$URL,1,4))), NA, paste(sotkanet, substr(d4$URL,1,4), sep=""))
d2$URL <- ifelse(
 
  is.na(as.numeric(substr(d2$URL,1,4))),
######################### HNH2035
  NA,
 
  paste0(sotkanet, substr(d2$URL,1,4))
# Siirrä nämä ECD-tauluun.
coln <- c(
  "Teema",
  "Nro",
  "Toimenpide",
  "Ohjelma",
  "Vastuu",
  "Aikajänne",
  "Vaativuus",
  "Kustannukset",
  "Kust.kaupungille",
  "Hyödyt.kaupungille",
  "Kust.muille",
  "Hyödyt.muille",
  "Päästövähenemä",
  "Muut.vaikutukset",
  "Seurantaindikaattori",
  "Esimerkki",
  "Lisätietoa"
)
)


####### HNH2035-toimenpiteet
####### HNH2035-toimenpiteet


d2 <- gsheet2tbl("https://docs.google.com/spreadsheets/d/1ejh-esNcuTjhoPWWqN7rC80xFtKKXu2n7PIUCDSOR98/edit#gid=885669064")
# Tämä koodi on tilapäinen ja pitäisi korjata alkuperäiseen taulukkoon. Sano Sonjalle.
d2 <- d2[5:nrow(d2),1:9] # Many columns are empty at the moment
colnames(d2) <- coln[1:9]
 
repl <- array(c(
repl <- array(c(
   "S&C säätiö","Smart&Clean",
   "S&C säätiö","Smart&Clean",
Rivi 245: Rivi 246:
dim=c(2,28)
dim=c(2,28)
)
)
d1 <- out[[8]]
for(i in 1:ncol(repl)) {
for(i in 1:ncol(repl)) {
   d2$Vastuu <- gsub(repl[1,i],repl[2,i],d2$Vastuu)
   d1$Vastuu <- gsub(repl[1,i],repl[2,i],d1$Vastuu)
}
}
d1 <- fillprev(d1,"Teema")
d1 <- d1[!is.na(d1$Nro) , ]
# d1 <- splizzeria(d1, cols="Kustannukset", split="/") # Not used because doubles relations


d2 <- ecd_build(
temp <- splizzeria(d1, cols="Vastuu", split=",")
  df = d2,
 
  oldid = "HNH2035",
d1 <- orbind(
  fills="Teema",
  spliz="Vastuu",
  split=",",
  removes=list(Nro=NA)
)
# d2 <- splizzeria(d2, cols="Kustannukset", split="/") # Not used because doubles relations
colnames(d2)[colnames(d2)=="Toimenpide"] <- "Item"
d2 <- orbind(
   cbind(
   cbind(
    Oldid=paste0("HNH2035/tp.", d1$Nro),
     type="HNH2035-toimenpide",
     type="HNH2035-toimenpide",
     label=substr(d2$Item,1,25),
    Item=d1$Toimenpide,
    d2,
     label=substr(d1$Toimenpide,1,30),
     Relation="teema",
     Relation="teema",
     Object=d2$Teema
     Object=d1$Teema,
    Description = paste(d1$Aikajanne, d1$Vaativuus, d1$Kustannukset, sep=". ")
   ),
   ),
   data.frame(
   data.frame(
     Item=d2$Item,
     Item=temp$Toimenpide,
     Relation="vastuullisena",
     Relation="vastuullisena",
     Object=d2$Vastuu
     Object=temp$Vastuu
   )
   )
)
)


# Toimijalistaus
# Hiilineutraalin Helsingin toimijalistaus


d3 <- html_table(read_html("http://fi.opasnet.org/fi/Hiilineutraali_Helsinki_2035"))[[2]]
d0 <- out[[13]]
d3$type <- gsub("Toimija","toimija",d3$type)
d0$type=tolower(d0$type)
d0$label=substr(d0$Item,1,30)


d3 <- ecd_build(
########################### Create ecd_graph
  df = data.frame(
    type=as.character(d3$type),
    label=as.character(d3$Nimi),
    Item=as.character(d3$Nimi)
  ),
  oldid = "HNHtoimija"
)


d3 <- orbind(d2, d3)
d <- orbind(orbind(orbind(d3, d2), d1), d0)
d3$Description <- paste(d3$Aikajänne, d3$Vaativuus, d3$Kustannukset, sep=". ")
d$label <- ifelse(is.na(d$label), substr(d$Item,1,30), d$label)
for(i in 1:ncol(d3)) d3[[i]] <- as.character(d3[[i]])


gr <- ecd_create(d)


gr <- ecd_create(d)
gr <- deselect_edges(gr, get_selection(gr))
gr <- select_edges(gr, conditions = grepl("Hyte", gr$edges_df$Oldid))


gr <- deselect_nodes(gr, get_selection(gr))
gr <- deselect_nodes(gr, get_selection(gr))
gr <- select_edges(gr, conditions = grepl("Lape", gr$edges_df$Oldid))
gr <- select_nodes(gr, conditions = grepl("HNH2035", gr$nodes_df$Oldid))


gr <- select_nodes_in_neighborhood(
#gr <- select_nodes_in_neighborhood(
  gr,
gr,
  node=gr$nodes_df$id[gr$nodes_df$label=="koulutervhuolto"][1],
node=gr$nodes_df$id[gr$nodes_df$label=="koulutervhuolto"][1],
  distance=2
distance=2
)
#)
get_selection(gr)
#get_selection(gr)


render_graph(gr)
#render_graph(gr)
render_graph(transform_to_subgraph_ws(gr))
render_graph(transform_to_subgraph_ws(gr))
export_graph(transform_to_subgraph_ws(gr), "test7.png")
export_graph(transform_to_subgraph_ws(gr), "test7.svg")
export_graph(gr, "test7.pdf")
#export_graph(gr, "test7.pdf")
</rcode>
</rcode>



Versio 5. heinäkuuta 2018 kello 18.45




Ympäristöterveysindikaattori on elinympäristön tiettyä ominaisuutta mittaava asia, joka kertoo ympäristön terveellisyydestä ihmiselle.

Kysymys

Mitkä ovat hyödyllisiä indikaattoreita Suomen ympäristöterveystilanteen seuraamiseksi ja parantamiseksi?

Vastaus

Ympäristötervyden keskeiset tekijät, toimenpiteet ja mittarit.

Nämä indikaattorit ovat olemassa tai suunnitteilla:

  • Pienhiukkaspitoisuuden väestöpainotettu vuosikeskiarvo (Yhteistyötilat)
  • Sisätilaongelmista koulussa raportoivat koululaiset
  • Vesivälitteisten epidemioiden lukumäärät ja sairastuneiden lukumäärät
  • Elintarvikevälitteisten epidemioiden lukumäärät ja sairastuneiden lukumäärät

Perustelut

Data

Näkemysverkkojen tietotauluja

Data on muodostettu koodilla:

+ Näytä koodi

Työlista

  • Tee Google sheet, jonne listataan kaikki Sitran 100 fiksua tekoa siten, että sarakkeisiin tulevat
    • Nimi (arjen teon nimi)
    • Suuruus (onko vaikutus pieni, keskisuuri vai suuri)
    • Aihepiiri (liittyykö teko asumiseen, matkustamiseen jne)
    • URL sivulle, jossa teko esitellään
  • Tutustu uuteen kuvaukseen Helsingin ilmastopolitiikasta:
  • Tutustu kuvaukseet ruuhkamaksuista (Decision analysis and risk management 2017 -kurssilla tehty)
  • Tutustu sanastoon sivulla op_en:Structure of shared understanding ja kommentoi kummallisuuksia ja epäselvyyksiä.
  • Tutustu kaavioiden muotoiluihin sivulla op_en:Extended causal diagram ja kommentoi kummallisuuksia ja epäselvyyksiä. Kaavioiden toteutus R-paketilla DiagrammeR nettisivu, dokumentaatio.
  • Tutustu ympäristöterveyden indikaattoreihin sivulla Ympäristöterveys
  • Käytä näitä keskustelumuotoiluja kun haluat kommentoida sivun sisältöä Opasnetissä:
    • Kommentti:
      {{comment|# (tarvittaessa argumentin numero)|Kommentoiva argumentti.|--~~~~}}
    • Puolusta:
      {{defend|# (tarvittaessa argumentin numero)|Puolustava argumentti.|--~~~~}}
    • Kommentti:
      {{attack|# (tarvittaessa argumentin numero)|Hyökkäävä argumentti.|--~~~~}}

Syykaaviot

+ Näytä koodi

Sisäilma kouluissa

Kouluterveyskysely tuottaa jotakin tietoa myös sisäilmasta, oppimisympäristöstä yleensä ja oppilaiden raportoimista yleisistä oireista. Katso lisätietoa näistä linkeistä:


+ Näytä koodi

Indikaattorien lataus Sotkanettiin

+ Näytä koodi

Sotearvioinnin koodi liittyen ympäristöterveyteen

+ Näytä koodi

Katso myös