+ Näytä koodi- Piilota koodi
# Tämä on koodi Op_fi5810/ sivulla [[Ympäristöterveysindikaattori]]
library(OpasnetUtils)
library(gsheet)
objects.latest("Op_en3861",code_name="ecd_create")
sotkanet <- "http://www.sotkanet.fi/sotkanet/fi/metadata/indicators/"
kouluterveyskysely <- "https://sampo.thl.fi/pivot/prod/fi/ktk/ktk1/summary_perustulokset?alue_0=87869&mittarit_0=200138&mittarit_1=187196&mittarit_2=199373&vuosi_2017_0=v2017"
kouluterveyskysely <- "https://sampo.thl.fi/pivot/prod/fi/ktk/ktk1/fact_ktk_ktk1?row=measure-200346.199405.199681.199445.199678.199701.199935.200120.199469.199308.199973.200279.200316.199604.&column=time-199465&column=stage_of_stady-161293.161123.161219.#" # Keskeiset ympäristöterveyden oire- ja olosuhdeindikaattorit eri kouluasteilla
tietoikkuna <- "https://proto.thl.fi/tietoikkuna/#/chart?indicatorId="
# Sotkanet.ID = tietoikkuna.indicatorID
coln <- c(
"Ikäryhmä",
"AHVK", # Alueellinen hyvinvointikertomus
"Item",
"Tehtäväkokonaisuus",
"Ulottuvuus",
"Osiotyyppi",
"Tietolähde",
"Kuvaid",
"Sotkanetid",
"JHS",
"Perustelut",
"Taso",
"Tiheys",
"Viive",
"Velvoite",
"Huom",
"Viite"
)
####### Hyte-indikaattorit
d2 <- gsheet2tbl("https://docs.google.com/spreadsheets/d/1mVlLcvsDFHKivD8rSDyn3ijfvoUAjxnXOGb-nujLDak/edit#gid=0")
d2 <- d2[3:98,]
colnames(d2) <- coln
d2 <- ecd_build(
df = d2,
oldid = "Hyte",
spliz = c("Ulottuvuus","Osiotyyppi","JHS"),
split = "/"
)
###### Lape-indikaattorit
d3 <- gsheet2tbl("https://docs.google.com/spreadsheets/d/1mVlLcvsDFHKivD8rSDyn3ijfvoUAjxnXOGb-nujLDak/edit#gid=2010476788")
d3 <- d3[9:nrow(d3),] # Kopioitiin vain 2018 indikaattorit driveen.
colnames(d3) <- coln[3:11]
d3 <- ecd_build(
df = d3,
oldid = "Lape",
spliz = c("JHS"),
split = ","
)
#d3<-d2
d3 <- orbind(d2, d3) # Apparently too much nodes so choose one.
d3 <- orbind(orbind(orbind(
data.frame(
Oldid = d3$Oldid,
type = paste(d3$Tehtäväkokonaisuus, "indikaattori",sep="-"),
Item = d3$Item,
Relation = "ulottuvuus",
Object = d3$Ulottuvuus,
URL = ifelse(d3$Sotkanetid %in% c("ei","e"), NA, paste(sotkanet, substr(d3$Sotkanetid,1,4), sep="")),
Description = d3$Perustelut,
label = substr(d3$Item,1,25)
),
# data.frame(
# Item = d3$Item,
# Relation = "on osana",
# Object = ifelse(d3$AHVK=="x", "Alueellinen hyvinvointikertomus", NA)
# )),
data.frame(
Item = d3$Item,
Relation = "osiotyyppi",
Object = d3$Osiotyyppi
)),
data.frame(
Item = d3$Item,
Relation = "discussed in",
Object = d3$Tietolähde
)),
data.frame(
Item = d3$Item,
Relation = "JHS-luokka",
Object = d3$JHS
)
)
for(i in 1:ncol(d3)) d3[[i]] <- as.character(d3[[i]])
d3$Object <- tolower(d3$Object)
d1 <- ecd_build(
tablelist =html_table(read_html("https://yhteistyotilat.fi/wiki08/x/1oGxAg"))[[3]][c(1,2,3,4),],
removes = NULL,
spliz = "Objekti",
split=",",
fills = c("Luokka","Predikaatti","Objekti")
)
d <- orbind(d1, d3)
d4 <- html_table(read_html("https://yhteistyotilat.fi/wiki08/x/WQmwAg"))[[5]]
for(i in 1:4) d4[[i]] <- tolower(d4[[i]])
d4$URL <- ifelse(is.na(as.numeric(substr(d4$URL,1,4))), NA, paste(sotkanet, substr(d4$URL,1,4), sep=""))
d4$Oldid <- paste("ALih",1:nrow(d4),sep="")
d4$Description <- ""
d4$label <- substr(d4$Item,1,50)
d <- d4
gr <- ecd_create(d)
gr <- deselect_nodes(gr, get_selection(gr))
gr <- select_edges(gr, conditions = grepl("Lape", gr$edges_df$Oldid))
gr <- select_nodes_in_neighborhood(
gr,
node=gr$nodes_df$id[gr$nodes_df$label=="koulutervhuolto"][1],
distance=2
)
get_selection(gr)
render_graph(gr)
render_graph(transform_to_subgraph_ws(gr))
export_graph(transform_to_subgraph_ws(gr), "test7.png")
export_graph(gr, "test7.pdf")
| |