Commit 37b2e845 authored by Helmer Belbo's avatar Helmer Belbo
Browse files

Major improvements: adding data, adding functions, expanding time span for regional edits.

parent 2b9e5087
......@@ -2,7 +2,8 @@
export(ld.fylke.mnd)
export(ld.kommune)
export(ssb_skog_omsetning)
export(regnavn.at.ref.yr)
export(t03794)
export(t03895)
export(t06216)
export(t12750)
#' Region navn og region kode for gitt år
#'
#' Denne funksjonen tar regionkoder og regionnavn fra en regional statistikk,
#' tar inn tabell som viser historiske endringer i regional inndeling av Norge
#' og gjør om til riktige koder og navn for et gitt referanseår (ref.yr)
#' Funksjonen fungerer for fylkesnivå inkludert landet ELLER for kommunenivå.
#'
#' @param regionstat
#' @param ref.yr
#' @param reg_level is the region level in the regionstat ("fylke" | kommune")
#'
#' @return tibble having the regional statistics including the regional
#' names and codes for the reference year in question
#' @export
#'
#' @examples regnavn.at.ref.yr(regionstat = t12750(), ref.yr = 2020 ) %>% glimpse()
regnavn.at.ref.yr<- function(regionstat, ref.yr = year(now()), reg_level = "fylke"){
# regionstat = t12750() #for testing
# Fetch the relevant region reference table regref
if (reg_level == "fylke"){ regref <- regref_fylke
} else { regref <- regref_kommune}
# harmonizing
ref.yr = as.integer(ref.yr)
glimpse(regref)
# Fetching from regref
regref = as.data.frame(regref, stringsAsFactors = F)
regref_n <- names(regref) #their column names
regref_yr <- as.integer(stringr::str_extract(names(regref), "\\d{4}")) #year
regref_typ <- stringr::str_sub(regref_n, 5, 8) # type (code / name)
glimpse(tibble(regref_yr = regref_yr, regref_typ = regref_typ))
glimpse(regionstat[seq.int(1, dim(regionstat)[1], length.out = 10), ])
regionstat <-
regionstat %>%
dplyr::mutate(.,
# for each obs in regionstat: tag which column in regreft one should fetch the name and code
# when to fit with the ref.yr.
regref_ref.yr_col_code =
max( which(regref_yr <= ref.yr & regref_typ == "code") ),
regref_ref.yr_col_name =
max( which(regref_yr <= ref.yr & regref_typ == "name") ))
glimpse(regionstat[seq.int(1, dim(regionstat)[1], length.out = 10), ])
print(paste0("regionstat$ar: ", str(regionstat$ar)))
print(paste0("regref_yr : ", str(regref_yr)))
regionstat <-
regionstat %>%
dplyr::mutate(.,
# For each obsrv in the regionstat:
# which column in regref the "ar" belongs to;
# = ar_regref_col_rcode and ar_regref_col_rname
yr_regref_col_rcode = purrr::pmap_int(., .f = function(ar, ...){
max( which( regref_yr <= ar & regref_typ == "code") )
}),
yr_regref_col_rname = purrr::pmap_int(., .f = function(ar, ...){
max( which( regref_yr <= ar & regref_typ == "name") )
}))
glimpse(regionstat[seq.int(1, dim(regionstat)[1], length.out = 10), ])
regionstat <-
regionstat %>%
dplyr::mutate(.,
# if each regionstat$region is present in the column in regref
# corresponding to the year of observation in regionstat
# = recode_regref_row
regcode_in_regrefcol = purrr::pmap_lgl(., .f = function(region_kode, yr_regref_col_rcode, ...){
case_when(
region_kode %in% regref[, yr_regref_col_rcode] ~ T,
TRUE ~ F)
}),
# and which row in regref the region_code belongs to:
# = recode_regref_row
regcode_regref_row = purrr::pmap_int(., .f = function(region_kode, yr_regref_col_rcode, ...){
case_when(
region_kode %in% regref[, yr_regref_col_rcode] ~
which( regref[, yr_regref_col_rcode] == region_kode)[1] ,
TRUE ~ NA_integer_)
})
) %>%
#
dplyr::mutate(.,
valid_reg =
dplyr::case_when(
regcode_in_regrefcol | region_kode == "0" ~ T,
TRUE ~ F))
glimpse(regionstat)
regionstat <- regionstat %>%
dplyr::filter(., valid_reg == TRUE) %>%
# Then we have indexes needed to pick the right row and column
# to populate both reg_k@ref.yr and reg_n@ref.yr
dplyr::mutate(.,
!!sym(paste0("reg_n", ref.yr)) := coalesce(regref[cbind(regcode_regref_row, regref_ref.yr_col_name)], region),
!!sym(paste0("reg_k", ref.yr)) := coalesce(regref[cbind(regcode_regref_row, regref_ref.yr_col_code)], region_kode)
)
return(regionstat)
}
##### t03794
#' Skogsavvirkning bruttoverdi t03794
#' bruttoverdi per år av tømmer, SSB tabell 03794
#'
#' Tabellen gir totalverdi av tømmer solgt per år og geografisk enhet, fra 1996 til 2018.
#' Litt usikker om energivirkesortimenter og ved er med.
#' https://www.ssb.no/statbank/list/skogav
#'
#' @param geolevel
#'
#' @return en tibble med hele datasetet.
#' @export
#'
#' @examples
#' t03794()
t03794 <- function(geolevel = 'fylke'){
if (!(geolevel %in% c("fylke", "kommune", "landet"))) {stop("warning: to get result, ret should be one of 'fylker', 'kommuner', 'landet'" )}
metadt <- PxWebApiData::ApiData("http://data.ssb.no/api/v0/no/table/03794", returnMetaData = TRUE)
regs <- unlist(purrr::flatten(metadt[[1]][3]))
kommuner <- regs[stringr::str_length(regs) == 4]
fylker <- regs[stringr::str_length(regs) == 2]
landet <- regs[stringr::str_length(regs) == 1]
geolevels <- list(kommune = kommuner, fylke = fylker, landet = landet)
geoselector <- which(names(geolevels) == geolevel)
pxdt <- PxWebApiData::ApiData("http://data.ssb.no/api/v0/no/table/03794",
#Region = T, #c(landet, geolevels[[geoselector]]),
Region = c(landet, geolevels[[geoselector]]),
Tid = T, #c("2010", "2016", "2017"),
ContentsCode = T # 10i)
)
regioner_utvalg <-
dplyr::as.tbl(pxdt[[1]]) %>%
dplyr::rename(., bruttoverdi = value) %>%
dplyr::group_by(region) %>%
dplyr::summarize(., volumtot = sum(bruttoverdi, na.rm = T)) %>%
dplyr::filter(., volumtot > 0) %>%
dplyr::pull(., region)
ds <- dplyr::as.tbl(pxdt[[2]]) %>%
dplyr::rename(., region_kode = Region, ar = Tid)
bruttov <- dplyr::as.tbl(pxdt[[1]]) %>%
dplyr::rename(., ar = år, bruttoverdi = value) %>%
dplyr::bind_cols(., (ds %>% dplyr::select(., region_kode))) %>%
dplyr::filter(., region %in% regioner_utvalg) %>%
dplyr::mutate(., ar = as.integer(ar)
)
return(bruttov)
}
##### t12750
#' Skogsavvirkning priser t12750
#' prisstatistikk for tømmer fra SSB tabell 12750
#'
......@@ -54,7 +112,7 @@ t12750 <- function(){
##### t06216
#' Skogsavvirkning priser t06216
#' prisstatistikk for tømmer SSB tabell 06216
#'
......@@ -112,6 +170,7 @@ t06216 <- function(){ # NB: avslutta, tidsserie 1996 - 2017
return(priser)
}
####### t03794
#' Skogsavvirkning volum t03895
#' Hogststatistikk for tømmer SSB tabell 03895
#' 1996 - 2018
......@@ -126,15 +185,15 @@ t06216 <- function(){ # NB: avslutta, tidsserie 1996 - 2017
#'
#' @examples
#' t03895()
t03895 <- function( geolevel = 'fylke'){ # 1996 - 2018
t03895 <- function(geolevel = 'fylke'){ # 1996 - 2018
if ( !(geolevel %in% c("fylke", "kommune", "landet"))){ stop("warning: to get result, ret should be one of 'fylker', 'kommuner', 'landet'" )}
if ( !(geolevel %in% c("fylke", "kommune", "landet"))) { stop("warning: to get result, ret should be one of 'fylker', 'kommuner', 'landet'" )}
metadt <- PxWebApiData::ApiData("http://data.ssb.no/api/v0/no/table/03895", returnMetaData = TRUE)
regs <- unlist(purrr::flatten(metadt[[1]][3]))
kommuner <- regs[stringr::str_length(regs)==4]
fylker <- regs[stringr::str_length(regs)==2]
landet <- regs[stringr::str_length(regs)==1]
kommuner <- regs[stringr::str_length(regs) == 4]
fylker <- regs[stringr::str_length(regs) == 2]
landet <- regs[stringr::str_length(regs) == 1]
geolevels <- list(kommune = kommuner, fylke = fylker, landet = landet)
geoselector <- which(names(geolevels) == geolevel)
......@@ -158,7 +217,8 @@ t03895 <- function( geolevel = 'fylke'){ # 1996 - 2018
dplyr::rename(., region_kode = Region, ar = Tid, virkeskategori = Treslag)
volum <- dplyr::as.tbl(pxdt[[1]]) %>%
dplyr::rename(., ar = år, kategoritekst = sortiment, volum_m3pris = value) %>%
dplyr::rename(., ar = år, kategoritekst = sortiment, volum_m3pris = value) %>%
dplyr::bind_cols(., (ds %>% dplyr::select(., region_kode, virkeskategori))) %>%
dplyr::filter(., region %in% regioner_utvalg) %>%
dplyr::mutate(.,
......@@ -175,38 +235,11 @@ t03895 <- function( geolevel = 'fylke'){ # 1996 - 2018
stringr::str_sub(virkeskategori, 1,2) %in% c("14", "24", "34") ~ "massevirke",
TRUE ~ "annet"
),
ar = as.numeric(ar)
ar = as.integer(ar)
)
return(volum)
}
#' SSB skogsavvirkning for salg: omsetning
#'
#' Denne henter tabellene for prishistorikk t12750 og hogstvolum t03895 og setter dem sammen.
#' https://www.ssb.no/statbank/list/skogav
#' @return en tibble med pris og volum fordelt på fylker og sortimentgrupper og år.
#' @export
#'
#' @examples
#' ssb_skog_omsetning()
ssb_skog_omsetning = function(){
priser_t12750 <- t12750()
volum_t03895 <- t03895()
begge <-
dplyr::full_join(
priser_t12750 %>%
select(., region, region_kode, ar, treslag, virkeskategori, sortimentgruppe, pris),
volum_t03895 %>%
dplyr::filter(., ar >= min(priser_t12750$ar)) %>%
dplyr::select(., region, region_kode, ar, treslag, volum_m3pris, virkeskategori, sortimentgruppe ) %>%
dplyr::group_by(., region, region_kode, ar, treslag, virkeskategori, sortimentgruppe) %>%
dplyr::summarize(., volum_m3pris = sum(volum_m3pris)),
by = c("region", "region_kode", "ar", "treslag", "virkeskategori", "sortimentgruppe")) %>%
dplyr::rowwise() %>%
mutate(., omsetning = as.double(pris) * volum_m3pris ) %>%
ungroup()
return(begge)
}
File added
......@@ -4,8 +4,8 @@ Landbruksdirektoratet is providing statistics for annual cut at municipality lev
in excel sheets, one excel document for each year.
https://www.landbruksdirektoratet.no/no/statistikk/skogbruk/tommeravvirkning
SSB provide similar statistics, but at county level, annual resolution and
a bit more lagged publication.
SSB provide similar statistics, but some of it only at county level, annual resolution and
a bit more lagged publication. But longer history.
https://www.ssb.no/statbank/list/skogav
......@@ -16,7 +16,9 @@ This should install it to R:
`devtools::install_git('https://gitlab.nibio.no/hbel/vsop.git')`
Load dependent packages:
`invisible(lapply(c("magrittr","stringr","dplyr","tibble","lubridate","readxl","PxWebApiData"),library,character.only =T))`
`invisible(
lapply( c("magrittr","stringr","dplyr","tibble","lubridate","readxl","PxWebApiData"),
library,character.only =T))`
Demo:
`vsop::ssb_skog_omsetning()`
......
## code to prepare `DATASET` dataset goes here
region_at_time_txtfls = function(filename){
# function returning the mapping from one region name and code tag to the next according to the SSB region classification
#Fylker: https://www.ssb.no/en/klass/klassifikasjoner/104/versjon/1158/koder
#Kommuner: https://www.ssb.no/en/klass/klassifikasjoner/131
# filename = files[1]
#readr::guess_encoding(filename)
datastring = readLines(filename, n=-1L,
encoding = dplyr::pull(readr::guess_encoding(filename)[1,1]),
warn = F)#nchars = 10^6)
headings = unlist(stringr::str_split(datastring[1], "\t"))
print(headings)
datastring = datastring[-1]
if((length(headings)%% 2) == 0 & length(datastring)>1) {
# Then string should be arranged to pairs of "froms" and "tos"
datastring = stringr::str_remove(datastring, pattern = "\t")
convtable = matrix(data = datastring, ncol = 2, byrow = T)
colnames(convtable) = headings
headingsinv = unlist(lapply(X= str_split(headings, " "), FUN = function(X){paste0(X[2]," ", X[1], " 1")}))
colnamecandidates = stringr::str_sub(
stringr::str_replace_all(
string = lubridate::ymd(headingsinv),
pattern = "-",
replacement = ""),
start=1, end = 6)
convtable = dplyr::as_tibble(as.data.frame(convtable, stringsAsFactors=F))
froms = dplyr::as_tibble(
str_split(
string = dplyr::pull(convtable[,1]), pattern = " - ", n=2, simplify = T))
colnames(froms) = paste(c("reg_code", "reg_name"), rep(colnamecandidates[1], 2), sep = "_")
tos = dplyr::as_tibble(
stringr::str_split(
string = dplyr::pull(convtable[,2]), pattern = " - ", n=2, simplify = T))
colnames(tos) = paste(c("reg_code", "reg_name"), rep(colnamecandidates[2], 2), sep = "_")
fromstos = dplyr::bind_cols(froms, tos)
} else if((length(headings)%% 2) == 1 & length(datastring)>1) {
# Then it is the starting point, i.e, first array of region units
convtable = matrix(data = datastring, ncol = 1, byrow = T)
#colnames(convtable) = headings
headingsinv =
unlist(lapply(X= stringr::str_split(headings, " "),
FUN = function(X){ paste0(X[2]," ", X[1], " 1")
}))
colnamecandidates =
stringr::str_sub(
stringr::str_replace_all(
string = lubridate::ymd(headingsinv),
pattern = "-",
replacement = ""), start=1, end = 6)
convtable = as.data.frame(convtable, stringsAsFactors=F )
froms = data.frame(
stringr::str_split(
string = convtable[,1],
pattern = " - ",
n=2,
simplify = T), stringsAsFactors = F )
colnames(froms) = paste(c("reg_code", "reg_name"), rep(colnamecandidates[1], 2), sep = "_")
fromstos = dplyr::as_tibble(froms)
} else if((length(headings)%% 2) == 0 & length(datastring) == 0) { # THen it is an empty update but we still need the "update dates"
headingsinv = unlist(lapply(X= str_split(headings, " "), FUN = function(X){paste0(X[2]," ", X[1], " 1")}))
colnamecandidates = stringr::str_sub(
stringr::str_replace_all(
string = lubridate::ymd(headingsinv),
pattern = "-",
replacement = ""),
start=1, end = 6)
froms = data.frame(
matrix(
data = c("a", "b"),
ncol = 2, byrow = T)[NULL, ],
stringsAsFactors = F)
colnames(froms) =
paste(c("reg_code", "reg_name"), rep(colnamecandidates[1], 2), sep = "_")
tos = data.frame(
matrix(data = c("a", "b"),
ncol = 2, byrow = T)[NULL, ],
stringsAsFactors = F)
colnames(tos) = paste(c("reg_code", "reg_name"), rep(colnamecandidates[2], 2), sep = "_")
fromstos = dplyr::bind_cols(dplyr::as_tibble(froms), dplyr::as_tibble(tos))
} else {fromstos = NULL}
return(fromstos)
}
regupdated = function(files){
regiondef = region_at_time_txtfls(filename = files[1])
for (i in 2:length(files)){
print(i)
regupdate = region_at_time_txtfls(filename = files[i])
## !! coming left_join: It would be best to find a way to join only by the "reg_code_x" variables but I could not find how to type this :-(
both = dplyr::left_join(regiondef, regupdate)
head(both)
regupnames <- names(both)
regupnamesl <- length(regupnames)
both %>%
dplyr::mutate(.,
!!sym(regupnames[regupnamesl-1]) :=
dplyr::case_when(
!is.na(!!dplyr::sym(regupnames[regupnamesl-1])) ~
!!dplyr::sym(regupnames[regupnamesl-1]),
TRUE ~ !!dplyr::sym(regupnames[regupnamesl-3])),
!!sym(regupnames[regupnamesl]) :=
dplyr::case_when(
!is.na(!!dplyr::sym(regupnames[regupnamesl])) ~ !!dplyr::sym(regupnames[regupnamesl]),
TRUE ~ !!dplyr::sym(regupnames[regupnamesl-2]))
) -> regiondef
}
return(regiondef)
}
no.regiontabell.flk = function(){
#Fylker: https://www.ssb.no/en/klass/klassifikasjoner/104/versjon/1158/koder
files <- list.files( path = "./data-raw", pattern = ".txt", full.names = T) %>%
.[which(!stringr::str_detect(., "~"))] %>%
.[which(stringr::str_detect(., "Regindeling_Fylker"))]
inndeling <- regupdated(files = files)
return(inndeling)
}
no.regiontabell.kmn = function(){
#Kommuner: https://www.ssb.no/en/klass/klassifikasjoner/131
files <- list.files(path = "./data-raw", pattern = ".txt", full.names = T) %>%
.[which(!stringr::str_detect(., "~"))] %>%
.[which(stringr::str_detect(., "Regindeling_Kommuner"))]
inndeling <- regupdated(files = files)
return(inndeling)
}
regref_fylke <- no.regiontabell.flk()
regref_kommune <- no.regiontabell.kmn()
usethis::use_data(regref_kommune, regref_fylke, overwrite = T)
januar 1972
01 - Østfold
02 - Akershus
03 - Oslo
04 - Hedmark
05 - Oppland
06 - Buskerud
07 - Vestfold
08 - Telemark
09 - Aust-Agder
10 - Vest-Agder
11 - Rogaland
12 - Hordaland
14 - Sogn og Fjordane
15 - Møre og Romsdal
16 - Sør-Trøndelag
17 - Nord-Trøndelag
18 - Nordland
19 - Troms
20 - Finnmark Finnmárku
99 - Uoppgitt
\ No newline at end of file
January 1972 July 2006
\ No newline at end of file
juli 2006 januar 2018
16 - Sør-Trøndelag
50 - Trøndelag
17 - Nord-Trøndelag
50 - Trøndelag
\ No newline at end of file
januar 2018 januar 2020
01 - stfold
30 - Viken
02 - Akershus
30 - Viken
04 - Hedmark
34 - Innlandet
05 - Oppland
34 - Innlandet
06 - Buskerud
30 - Viken
07 - Vestfold
38 - Vestfold og Telemark
08 - Telemark
38 - Vestfold og Telemark
09 - Aust-Agder
42 - Agder
10 - Vest-Agder
42 - Agder
12 - Hordaland
46 - Vestland
14 - Sogn og Fjordane
46 - Vestland
19 - Troms Romsa
54 - Troms og Finnmark Romsa ja Finnmrku
20 - Finnmark Finnmrku
54 - Troms og Finnmark Romsa ja Finnmrku
\ No newline at end of file
januar 1994
0101 - Halden
0104 - Moss
0105 - Sarpsborg
0106 - Fredrikstad
0111 - Hvaler
0118 - Aremark
0119 - Marker
0121 - Rømskog
0122 - Trøgstad
0123 - Spydeberg
0124 - Askim
0125 - Eidsberg
0127 - Skiptvet
0128 - Rakkestad
0135 - Råde
0136 - Rygge
0137 - Våler
0138 - Hobøl
0211 - Vestby
0213 - Ski
0214 - Ås
0215 - Frogn
0216 - Nesodden
0217 - Oppegård
0219 - Bærum
0220 - Asker
0221 - Aurskog-Høland
0226 - Sørum
0227 - Fet
0228 - Rælingen
0229 - Enebakk
0230 - Lørenskog
0231 - Skedsmo
0233 - Nittedal
0234 - Gjerdrum
0235 - Ullensaker
0236 - Nes
0237 - Eidsvoll
0238 - Nannestad
0239 - Hurdal
0301 - Oslo
0402 - Kongsvinger
0403 - Hamar
0412 - Ringsaker
0415 - Løten
0417 - Stange
0418 - Nord-Odal
0419 - Sør-Odal
0420 - Eidskog
0423 - Grue
0425 - Åsnes
0426 - Våler
0427 - Elverum
0428 - Trysil
0429 - Åmot
0430 - Stor-Elvdal
0432 - Rendalen
0434 - Engerdal
0436 - Tolga
0437 - Tynset
0438 - Alvdal
0439 - Folldal
0441 - Os
0501 - Lillehammer
0502 - Gjøvik
0511 - Dovre
0512 - Lesja
0513 - Skjåk
0514 - Lom
0515 - Vågå
0516 - Nord-Fron
0517 - Sel
0519 - Sør-Fron
0520 - Ringebu
0521 - Øyer
0522 - Gausdal
0528 - Østre Toten
0529 - Vestre Toten
0532 - Jevnaker
0533 - Lunner
0534 - Gran
0536 - Søndre Land