diff --git a/app.R b/app.R new file mode 100644 index 0000000..35e53fa --- /dev/null +++ b/app.R @@ -0,0 +1,678 @@ + +library(shiny) +library(shinyWidgets) +library(tidyverse) +library(DT) +library(openxlsx) + +# Functions ---- + +#' Function that checks API-metadata variable info. +#' If the variable is a time variable the range is returned formatted into a string. +#' If the value text is more than 4 characters the first 4 characters are used +#' parameter node an item from apimeta$id$pxweb_metadata$variables +#' #' Note: id is the unique identifier for the variable in main table + +timecheck<-function(node){ + tekk1<-node$time + + if(tekk1){ + vt<-node$valueTexts + lns<-nchar(vt) + tekk2<-sum(lns==4)==length(lns) + if(!tekk2){ + vt<-substring(vt, 1, 4) + } + vt2<-as.numeric(vt) + r<-range(vt2) + skil<-paste0(", árabil: ", r[1], " - ", r[2], ", ") + }else{ + skil<-"" + } + return(skil) +} + +#' A function that returns the number of distinct values a variable takes +#' parameter node an item from apimeta$id$pxweb_metadata$variables +#' Note: id is the unique identifier for the variable in main table + +lengd<-function(node){ + vt<-node$valueTexts + ln<-length(vt) + skil<-paste0(ln, " gildi") +} + +# Data and setup ---- + +# Icelandic language labels for datatable + +DTsetup2<-list( + emptyTable="Ekkert fannst", + info="Sýnir _START_ til _END_ af _TOTAL_ töflum", + infoFiltered="(fækkað úr _MAX_ töflum samtals)", + lengthMenu="Sýna mest _MENU_ töflur", + search="Aðalleit", + zeroRecords="Ekkert fannst", + paginate=list( + "first"="Fyrsta", + "last"="Síðasta", + "next"="Næsta", + "previous"="Til baka" + ) +) + +# Main table +tafla<-readRDS("maintab1706470824.70881.rds") +# Metadata returned by API +apimeta<-readRDS("apimeta1706470824.96876.rds") +#Metadata from pxweb +pxwebmeta<-readRDS("pxwebmeta1706488768.31164.rds") + +# Extra variable added after last scrape. Should be moved to scraping script. + +timi<-rep("Nei", nrow(tafla)) +timi[!is.na(tafla$first_time)]<-"Já" +tafla$timi<-timi + + +# UI ---- + +ui <- fluidPage( + tags$style(HTML( + ".shiny-output-error { visibility: hidden; } + .shiny-output-error:before { visibility: hidden;}" + )), + titlePanel("pxmap"), + br(), + "Yfirlit yfir px-töflur á vef Hagstofu Íslands", + uiOutput("dateui"), + #br(), + hr(), + ## Filter inputs ---- + fluidRow( + style="padding: 10px;", + column(2, + br(), + dropdown(inputId ="crumbs1_dropdown", label="Flokkur 1", + awesomeCheckboxGroup("crumbs1_inp", + label="", + choices = unique(tafla$crumbs1), + selected = unique(tafla$crumbs1) + ) + ), + #br(), + textOutput("filtexti1") + ), + column(2, + uiOutput("crumbfilter2") + ), + column(2, + uiOutput("crumbfilter3") + ) + ), + ## Optional columns (Aukadálkar) ---- + fluidRow( + style="padding: 10px;", + dropdown(inputId ="extravars", label="Aukadálkar", + awesomeCheckboxGroup("extravars_inp", + label="", + choices = c(`Elsta skráning`="first_time", + `Nýjasta skráning`="last_time", + `Síðast uppfært`="last_update", + `Fjöldi endurtekninga`="n_duplicates", + `Með tímabreytu`="timi"), + selected = NULL) + ), + br(), + uiOutput("extravarcomment"), + ## Main table ---- + dataTableOutput("adaltafla"), + textOutput("toflutexti"), + #helpText("Þegar aðallleit er notuð til að leita er einnig leitað í öllum gildum sem skiptibreytur taka"), + tags$div( + title="Hlaða niður yfirlitstöflu eins og hún hefur verið valin hér að ofan", + downloadButton('tafla.xlsx', label="Hlaða niður yfirlitstöflu (xlxs)") + ), + br() + ), + ## Selected table information ---- + fluidRow( + style="padding: 20px;", + uiOutput("heiti_ui"), + br(), + tabsetPanel( + ### Paths (Slóðir)---- + tabPanel("Slóðir", + uiOutput("slodir_ui") + ), + ### Variables (Skiptibreytur) ---- + tabPanel("Skiptibreytur", + checkboxInput("syna_gildi", "Sýna gildi", value = F), + br(), + uiOutput("gildatexti") + ), + ### Metadata section (Lýsigögn) ---- + tabPanel("Lýsigögn", + tabsetPanel( + tabPanel( + #### pxweb metadata ---- + "Lýsigögn (px-vefur)", + fluidRow( + style="padding: 40px;", + "Upplýsingar um töflu af px-vef:", + br(), + br(), + "Athugið að dagsetning fyrir nýjustu uppfærslu er sú sem hún var þegar gögn voru síðast skröpuð af vef Hagstofunnar. Töflur kunna að hafa verið uppfærðar eftir það.", + br(), + br(), + fluidRow( + style = "border: 1px solid black; padding: 10px", + br(), + uiOutput("about"), + br() + ), + br(), + "Skýringar sem fylgja töflu á px-vef:", + br(), + br(), + fluidRow( + style = "border: 1px solid black; padding: 10px", + br(), + uiOutput("skyringar"), + br() + ) + ) + ), + tabPanel( + #### API-metadata ---- + "Lýsigögn (API)", + br(), + "Hér birtast lýsigögn úr skilalista þegar gögn eru sótt í gegn um API með R-pakkanum pxweb. Úttak birtist eins og það kemur af kúnni.", + br(), + br(), + "Athugið að dagsetning fyrir nýjustu uppfærslu er sú sem hún var þegar gögn voru síðast skröpuð af vef Hagstofunnar. Töflur kunna að hafa verið uppfærðar eftir það.", + br(), + br(), + checkboxGroupInput("apisyna", "Sýna", choices = c("columns", "comments", "metadata", + "pxweb_metadata", "url", "time_stamp"), + selected = "metadata", inline = T), + textOutput("apitext1"), + verbatimTextOutput("apiout1"), + textOutput("apitext2"), + verbatimTextOutput("apiout2"), + textOutput("apitext3"), + verbatimTextOutput("apiout3"), + textOutput("apitext4"), + verbatimTextOutput("apiout4"), + textOutput("apitext5"), + verbatimTextOutput("apiout5"), + textOutput("apitext6"), + verbatimTextOutput("apiout6") + ) + + ) + ) + ), + br(), + br(), + br(), + br(), + br(), + br() + ) + +) + +# Server ---- + +server <- function(input, output) { + + ## Date ---- + + # The date when data was last scraped is logged in apimeta list. + # UI output displaying formatted date. + + output$dateui<-renderUI({ + skil<-paste0("Gögn síðast sótt: ", format(apimeta$timastimpill_POSIXct, "%d.%m.%Y")) + HTML(skil) + }) + + + #Extravar comments ---- + + # Some "Aukadálkar" inputs require explanation. + # UI output displaying relevant comments. + + output$extravarcomment<-renderUI({ + skil<-"" + if("first_time"%in%input$extravars_inp|"last_time"%in%input$extravars_inp){ + skil<-paste0(skil, "Aðeins er hægt að sjá elstu og nýjustu skráningu fyrir þær tölfur sem eru með tímabreytu skilgreinda í API-skilum

") + } + if("last_update"%in%input$extravars_inp){ + skil<-paste0(skil, "Tímasetning fyrir síðustu uppfærslu birtist eins og hún kemur fram í API-skilum. Sum gildi eru ómöguleg.

") + } + if("n_duplicates"%in%input$extravars_inp){ + skil<-paste0(skil, "Fjöldi endurtekninga segir til um hversu oft nafn töflu kemur fyrir á px-vef.

") + } + if("timi"%in%input$extravars_inp){ + skil<-paste0(skil, "Breytan \"Með tímabreytu\" segir til um hvort tafla er með skilgreinda tímabreytu í API-skilum.

") + } + return(HTML(skil)) + }) + + + + ## filters---- + + # Main table is filtered sequentially by inputs crumbs1_inp, crumbs2_inp and crumbs3_inp + + # Reactive table filtered by input$crumbs1_inp + + tafla_filt1<-reactive({ + tafla_ut<- tafla%>% + filter(crumbs1%in%input$crumbs1_inp) + return(tafla_ut) + }) + + # Text output displaying the number of level 1 categories in ufiltered main table and the number of selected categories. + + output$filtexti1<-renderText({ + teljari<-length(input$crumbs1_inp) + nefnari<-length(unique(tafla$crumbs1)) + + paste0("( ", teljari, " / ", nefnari, " )") + }) + + + # Dynamic input for selecting level 2 categories from those represented in table after first filtering + + output$crumbfilter2<-renderUI({ + tafla2<-tafla_filt1() + + fluidRow( + style="padding: 20px;", + dropdown(inputId ="crumbs2_dropdown", label="Flokkur 2", + awesomeCheckboxGroup("crumbs2_inp", + label="", + choices = unique(tafla2$crumbs2), + selected = unique(tafla2$crumbs2) + ) + ), + textOutput("filtexti2") + ) + }) + + # Text output displaying the number of level 2 categories in main table after first filtering and the number of selected categories. + + output$filtexti2<-renderText({ + tafla2<-tafla_filt1() + + teljari<-length(input$crumbs2_inp) + nefnari<-length(unique(tafla2$crumbs2)) + + paste0("( ", teljari, " / ", nefnari, " )") + }) + + # Reactive table filtered by input$crumbs2_inp + + tafla_filt2<-reactive({ + tafla2<-tafla_filt1() + + tafla_ut<-tafla2%>% + filter(crumbs2%in%input$crumbs2_inp) + + return(tafla_ut) + }) + + # Dynamic input for selecting level 3 categories from those represented in table after second filtering + + output$crumbfilter3<-renderUI({ + tafla3<-tafla_filt2() + + fluidRow( + style="padding: 20px;", + dropdown(inputId ="crumbs3_dropdown", label="Flokkur 3", + awesomeCheckboxGroup("crumbs3_inp", + label="", + choices = unique(tafla3$crumbs3), + selected = unique(tafla3$crumbs3) + ) + ), + #br(), + textOutput("filtexti3") + ) + }) + + # Text output displaying the number of level 3 categories in main table after second filtering and the number of selected categories. + + output$filtexti3<-renderText({ + tafla3<-tafla_filt2() + + teljari<-length(input$crumbs3_inp) + nefnari<-length(unique(tafla3$crumbs3)) + + paste0("( ", teljari, " / ", nefnari, " )") + }) + + # Reactive table filtered by input$crumbs3_inp + + tafla_filt3<-reactive({ + tafla3<-tafla_filt2() + + tafla_ut<-tafla3%>% + filter(crumbs3%in%input$crumbs3_inp) + + return(tafla_ut) + }) + + + ## Table count ---- + + # Text output indicating the total number of tables in filtered main table, number of distinct table names + # and number of table names appearing more than once + + output$toflutexti<-renderText({ + tafla4<-tafla_filt3() + tafla_ut<-tafla4[input$adaltafla_rows_all,] + + tala1<-length(unique(tafla_ut$nofn2)) + + tidnitafla<-tafla_ut %>% + group_by(n_duplicates) %>% + tally() %>% + filter(n_duplicates>1) %>% + mutate(fj_tafl=n/n_duplicates) + + tala2<-sum(tidnitafla$fj_tafl) + + paste0(tala1, " einstök töfluheiti, ", tala2, " töfluheiti koma oftar en einu sinni fyrir") + }) + + ## Main table ---- + + # Reactive table pairing variable names in main table and display names + # Not really reactive, this is a workaround to solve problems that may be particular to server mvst + + labtab<-reactive({ + data.frame("tnames"=c("first_time", "last_time", "last_update", "n_duplicates", "timi"), + "dnames"=c("Elsta skráning", "Nýjasta skráning", "Síðast uppfært", "Fjöldi endurtekninga", + "Með tímabreytu")) + }) + + # Reactive vector of display names for selected "Aukadálkar" + + labs_varsel<-reactive({ + tab<-labtab()[labtab()$tnames%in%input$extravars_inp,] + skil<-tab$dnames + return(skil) + }) + + # Reactive datatable with main table + + preptafla<-reactive({ + tafla4<-tafla_filt3() + + tafla_ut<-tafla4%>% + select("crumbs1", "crumbs2", "crumbs3", "nofn2", "breytur", input$extravars_inp)%>% + datatable(colnames=c("Flokkur 1", "Flokkur 2", "Flokkur 3", "Heiti", "Skiptibreytur", labs_varsel()), + rownames= FALSE, filter = 'top', + selection = list(mode='single', selected=1), + options = list( + language=DTsetup2), + ) + + + return(tafla_ut) + }) + + # Main table output + + output$adaltafla<-renderDataTable({preptafla()}) + + + ## Table information ---- + + ### Paths (Slóðir) ---- + + # Reactive string with name of selected table + + heiti_rctv<-reactive({ + tafla4<-tafla_filt3() + tala<-input$adaltafla_rows_selected + + return(tafla4$nofn2[tala]) + }) + + # UI output. Name of selected table formated in html. + + output$heiti_ui<-renderUI({ + skil<-paste0("Heiti: ", heiti_rctv(), "") + HTML(skil) + }) + + # Reactive string with selected table pxweb url. + + slod_px_rctv<-reactive({ + tafla4<-tafla_filt3() + tala<-input$adaltafla_rows_selected + + return(tafla4$slod2[tala]) + }) + + # Reactive string with selected table API url. + + slod_api_rctv<-reactive({ + tafla4<-tafla_filt3() + tala<-input$adaltafla_rows_selected + + return(tafla4$apiurl[tala]) + }) + + # Reactive string with selected table breadcrumbs trail. + + tre_rctv<-reactive({ + tafla4<-tafla_filt3() + tala<-input$adaltafla_rows_selected + + return(tafla4$crumbs[tala]) + }) + + # UI output. pxweb url, API url and breadcrumbs formated in html. + + + output$slodir_ui<-renderUI({ + skil<-"
" + skil<-paste0(skil, "Slóð á px-vef:
",slod_px_rctv(),"") + skil<-paste0(skil, "

") + skil<-paste0(skil, "API-slóð:
", slod_api_rctv()) + skil<-paste0(skil, "

") + skil<-paste0(skil, "Staðsetning í tré:
", tre_rctv()) + HTML(skil) + }) + + ### Variables (Skiptibreytur) ---- + + # Reactive string. Selected table unique ID + + id_rctv<-reactive({ + tafla4<-tafla_filt3() + tala<-input$adaltafla_rows_selected + + return(tafla4$id[tala]) + }) + + # Reactive list with variable description from API + + vars_rctv<-reactive({ + nota<-apimeta[[id_rctv()]]$pxweb_metadata$variables + return(nota) + }) + + # UI output. Displays information about variables formatted in HTML + + output$gildatexti<-renderUI({ + vartre<-vars_rctv() + + if(input$syna_gildi){ + skil<-"" + for(i in 1:length(vartre)){ + skil<-paste0(skil, "", vartre[[i]]$text, " ") + skil<-paste0(skil, "   ",lengd(vartre[[i]]), "") + skil<-paste0(skil, " ",timecheck(vartre[[i]]), "") + skil<-paste0(skil, "
") + gildi<-paste0(vartre[[i]]$valueTexts, collapse = ", ") + skil<-paste0(skil,"", gildi, "

") + } + }else{ + skil<-"" + for(i in 1:length(vartre)){ + skil<-paste0(skil, "", vartre[[i]]$text, " ") + skil<-paste0(skil, "   ",lengd(vartre[[i]]), "") + skil<-paste0(skil, "",timecheck(vartre[[i]]), "") + skil<-paste0(skil, "

") + } + } + + skil<-paste0(skil, "

Árabil birtast aðeins við hlið breytuheita ef skiptibreytur eru skilgreindar sem tímabreytur í lýsigögnum") + + return(HTML(skil)) + + }) + + + ### Metadata section (Lýsigögn) ---- + + #### pxweb metadata ---- + + # Reactive string with table comment (skýringar) from pxweb. + + skyr_rctv<-reactive({ + return(pxwebmeta[[id_rctv()]]$skyringatexti) + }) + + # UI output.Returns skyr_rctv formatted in html if a comment was found during scraping. + # If no comment was found a notification is displayed. + + output$skyringar<-renderUI({ + + ut<-"" + + if(skyr_rctv()=="null"){ + ut<-paste0(ut,"Enginn skýringatexti fannst þegar gögn voru sótt") + }else{ + hratt<-skyr_rctv() + hratt<-gsub("\\n", "

", hratt) + ut<-paste0(ut, "", hratt, "") + } + HTML(ut) + }) + + # Reactive list of two char vectors + # One list contains headings from "Um töflu" section on pxweb, other contains the text contents + + about_rctv<-reactive({ + nota<-list() + nota$heiti<-pxwebmeta[[id_rctv()]]$sub_textar + nota$textar<-pxwebmeta[[id_rctv()]]$sub_bodies_textar + return(nota) + }) + + # UI ouput with contents of about_rctv formatted in html + + output$about<-renderUI({ + + ut<-"" + heiti<-unlist(about_rctv()$heiti) + texti<-unlist(about_rctv()$textar) + + for(i in 1:length(heiti)){ + ut<-paste0(ut, "", heiti[i], ": ", texti[i], "
") + } + + HTML(ut) + }) + + #### API-metadata ---- + + # Outputs named apioutput are verbatim text outputs diplaying the contents of each item in list returned by API + # Outputs named apitext are text outputs with headings for each section + # Both outputs are only displayed if the item is seleced in input apisyna + + output$apiout1<-renderPrint({ + if("columns"%in%input$apisyna){ + print(apimeta[[id_rctv()]]$columns) + } + }) + output$apitext1<-renderText({if("columns"%in%input$apisyna){"columns"}}) + + output$apiout2<-renderPrint({ + if("comments"%in%input$apisyna){ + print(apimeta[[id_rctv()]]$comments) + } + }) + output$apitext2<-renderText({if("comments"%in%input$apisyna){"comments"}}) + + output$apiout3<-renderPrint({ + if("metadata"%in%input$apisyna){ + print(apimeta[[id_rctv()]]$metadata) + } + }) + output$apitext3<-renderText({if("metadata"%in%input$apisyna){"metadata"}}) + + # Output apioutput4 prints the contents of two items + + output$apiout4<-renderPrint({ + if("pxweb_metadata"%in%input$apisyna){ + print(apimeta[[id_rctv()]]$pxweb_metadata$title) + print(apimeta[[id_rctv()]]$pxweb_metadata$variables) + } + }) + output$apitext4<-renderText({if("pxweb_metadata"%in%input$apisyna){"pxweb_metadata"}}) + + output$apiout5<-renderPrint({ + if("url"%in%input$apisyna){ + print(apimeta[[id_rctv()]]$url) + } + }) + output$apitext5<-renderText({if("url"%in%input$apisyna){"url"}}) + + output$apiout6<-renderPrint({ + if("time_stamp"%in%input$apisyna){ + print(apimeta[[id_rctv()]]$time_stamp) + } + }) + output$apitext6<-renderText({if("time_stamp"%in%input$apisyna){"time_stamp"}}) + + ## Download main table---- + + # Reactive table. Displayed rows from main table selected. Columns selected and renamed for xlsx export. + + dwnld_rctv<-reactive({ + tafla4<-tafla4<-tafla_filt3() + tafla_ut<-tafla4[input$adaltafla_rows_all,]%>% + select("Flokkur1"=crumbs1, + "Flokkur2"=crumbs2, + "Flokkur3"=crumbs3, + "Heiti"=nofn2, + "PX_slod"=slod2, + "API_slod"=apiurl, + "Skiptibreytur"=breytur, + "Fjoldi_med_sama_titil"=n_duplicates, + "Fyrsta_timaildi"=first_time, + "Sidasta_timagildi"=last_time) + }) + + # Download handler for dwnld_rctv + + output$tafla.xlsx <- downloadHandler( + filename = function() { + paste("tafla_ut.xlsx") + }, + content = function(file) { + write.xlsx(dwnld_rctv(), file, row.names = FALSE) + } + ) +} + +# Run the application +shinyApp(ui = ui, server = server)