Adiciona filtros para obras (nome de autor) e keywords

inst/ShinyApps/labestDataView/global.R

@@ -4,11 +4,11 @@
 library(xtable)
 library(labestData)
 
-L <- ls("package:labestData")
-i <- sapply(L, function(x) {
-    class(eval(parse(text = x)))
-})
-L <- L[i %in% c("data.frame", "numeric", "integer")]
+data(keywords, package = "labestData")
+keywords$obra <- gsub(
+    pattern = "^([A-Z]{1}[a-z]*)[A-Z]{1}[a-z]{1}.*$",
+    replacement = "\\1",
+    x = keywords$name)
 
 howmanydigits <- function(x) {
     x <- na.omit(x)

inst/ShinyApps/labestDataView/server.R

@@ -8,13 +8,62 @@ shinyServer(
             vers <- as.character(packageVersion("labestData"))
             tagList(
                 h1(paste("labestData: Biblioteca de dados para",
-                         "Ensino de Estatística"), class = "title"),
+                         "aprendizado de Estatística"),
+                   class = "title"),
                 h2(paste("PET-Estatística UFPR - Versão", vers),
                    class = "title"),
                 hr()
             )
         })
 
+        ## Cria listbox para seleção das obras
+        output$OBRAUI <- renderUI({
+            CHOICES <- c("Todas" = "", sort(keywords$obra))
+            selectInput(inputId = "OBRA",
+                        label = "Escolha a(s) obra(s)",
+                        choices = CHOICES, multiple = TRUE)
+        })
+
+        ## Cria listbox para seleção das keywords
+        output$KEYSUI <- renderUI({
+            CHOICES <- c("Todas" = "", levels(keywords$keyword))
+            selectInput(inputId = "KEYS", label = "Keyword(s)",
+                        choices = CHOICES, multiple = TRUE)
+        })
+
+        ## Separa o conjunto de dados com base nos filtros
+        DATACHOICE <- reactive({
+            OBRA <- input$OBRA
+            KEYS <- input$KEYS
+            if (is.null(OBRA) & is.null(KEYS)) {
+                DATA <- keywords
+            }
+            if (is.null(OBRA) & !is.null(KEYS)) {
+                DATA <- subset(keywords, keyword %in% KEYS)
+            }
+            if (!is.null(OBRA) & is.null(KEYS)) {
+                DATA <- subset(keywords, obra %in% OBRA)
+            }
+            if (!is.null(OBRA) & !is.null(KEYS)) {
+                DATA <- subset(keywords,
+                               obra %in% OBRA & keyword %in% KEYS)
+            }
+            return(DATA)
+        })
+
+        ## Cria listbox para seleção dos datasets
+        output$DATASETUI <- renderUI({
+            na <- sort(DATACHOICE()$name)
+            if (length(na) != 0) {
+                CHOICES <- c("Escolha um dataset" = "", na)
+            } else {
+                CHOICES <- c("Não há datasets" = "")
+            }
+            selectInput(inputId = "DATASET",
+                        label = "Dados disponíveis",
+                        choices = CHOICES)
+        })
+
         output$DOC <- renderPrint({
             if (input$DATASET != "") {
                 tmp <- tempfile()

inst/ShinyApps/labestDataView/ui.R

@@ -8,21 +8,29 @@ shinyUI(
         htmlOutput("HEADER"),
 
         fluidRow(
+
+            column(
+                width = 3,
+                uiOutput("OBRAUI")
+            ),
+            column(
+                width = 2,
+                uiOutput("KEYSUI")
+            ),
             column(
-                width = 4, ## offset = 2,
-                selectInput(inputId = "DATASET",
-                            label = "Dados disponíveis",
-                            choices = c("Escolha um dataset" = "", L))
+                width = 3, ## offset = 2,
+                uiOutput("DATASETUI")
             ),
             column(
-                width = 4,
+                width = 2,
                 HTML(paste('<label class="control-label">Baixe ',
                            'os dados:</label><br>', sep = "")),
                 downloadButton(outputId = "DOWNLOADDATA",
-                               label = "Download tsv")
+                               label = "",
+                               class = "btn btn-primary")
             ),
             column(
-                width = 2, offset = 2,
+                width = 2, ## offset = 2,
                 HTML(paste('<label class="control-label">Execução R:',
                            '</label><br>', sep = "")),
                 actionButton(inputId = "EXIT",