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

NAMESPACE

@@ -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)

R/no_regioninndeling.R

+
+#' 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)
+
+}
+
+
+
+
+
+
+
+
+

R/ssb_skogsavvirkning.R

+##### 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)
-}
 

README.md

@@ -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()`

data-raw/DATASET.R

+## 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)

data-raw/Regindeling_Fylker_1972_01_status.txt

+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

data-raw/Regindeling_Fylker_2006_7.txt

+January 1972	July 2006
\ No newline at end of file

data-raw/Regindeling_Fylker_2018_1.txt

+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

data-raw/Regindeling_Fylker_2020_1.txt

+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

data-raw/Regindeling_Kommuner_1994_status.txt

+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