small tables for attribute totals

Author: ebey

inst/shiny/global.R

@@ -155,7 +155,15 @@ hist.info <- function(x, breaks) {
   for(i in seq(length(out$breaks) - 2)){
     barname <- append(barname, paste(out$breaks[i+1]+1, out$breaks[i+2], sep = "-"))
   }
-  out <- out$counts
-  names(out) <- barname
+
+  out$percent <- out$counts/sum(out$counts)
+  names(out$counts) <- barname
+  names(out$percent) <- barname
   return(out)
 }
+
+attrtab <- function(obj, breaks) {
+  tab <- hist.info(obj, breaks = breaks)
+  tab < - rbind(tab, tab/sum(tab))
+  rownames(tab) <- c("count", "percent")
+}

inst/shiny/server.R

@@ -1441,11 +1441,50 @@ output$attrcheck <- renderUI({
 })
 outputOptions(output, "attrcheck", suspendWhenHidden = FALSE)
 
-output$attrtbl <- renderDataTable({
+output$attrtbl_lg <- renderDataTable({
   dt <- nwdf()[, c("Names", input$attrcols)]
   dt
 }, options = list(pageLength = 10))
 
+output$attrtbl_sm <- renderPrint({
+  ntbl <- length(input$attrcols)
+  if(ntbl == 0){return()}
+  attrname <- input$attrcols
+  tbl_list <- list()
+  if(ntbl == 1){
+    lvls <- length(unique(nwdf()[[attrname]]))
+    if(attrname %in% numattr() & lvls > 9){
+      tab <- hist(nwdf()[[attrname]], breaks = 10, plot = FALSE)
+      barname <- paste(tab$breaks[1:2], collapse = "-")
+      for(i in seq(length(tab$breaks) - 2)){
+        barname <- append(barname, paste(tab$breaks[i+1]+1, tab$breaks[i+2], sep = "-"))
+      }
+      tab <- tab$counts
+      names(tab) <- barname
+    } else {
+      tab <- table(nwdf()[[attrname]])
+    }
+    tbl_list[[attrname]] <- tab
+  } else {
+    for(a in attrname){
+      lvls <- length(unique(nwdf()[[a]]))
+      if(a %in% numattr() & lvls > 9){
+        tab <- hist(nwdf()[[a]], breaks = 10, plot = FALSE)
+        barname <- paste(tab$breaks[1:2], collapse = "-")
+        for(i in seq(length(tab$breaks) - 2)){
+          barname <- append(barname, paste(tab$breaks[i+1]+1, tab$breaks[i+2], sep = "-"))
+        }
+        tab <- tab$counts
+        names(tab) <- barname
+      } else {
+        tab <- table(nwdf()[[a]])
+      }
+      tbl_list[[a]] <- tab
+    }
+  }
+  tbl_list
+})
+
 output$attrhist <- renderPlot({
   nplots <- length(input$attrcols)
   if(nplots == 0){return()}
@@ -1458,7 +1497,8 @@ output$attrhist <- renderPlot({
            col = "#076EC3", lwd = 2)
     } else {
       if(attrname %in% numattr() & lvls > 9){
-        tab <- hist.info(nwdf()[[attrname]], breaks = 10)
+        out <- hist.info(nwdf()[[attrname]], breaks = 10)
+        tab <- out$counts
       } else {
         tab <- table(nwdf()[[attrname]])
       }

inst/shiny/ui.R

@@ -501,10 +501,13 @@ fluidRow(
                            )
         ),
       tabPanel('Attributes', br(),
-               conditionalPanel('input.attrview == "table"',
-                                dataTableOutput("attrtbl")
+               conditionalPanel('input.attrview == "Large table"',
+                                dataTableOutput("attrtbl_lg")
                                 ),
-               conditionalPanel('input.attrview == "histogram"',
+               conditionalPanel('input.attrview == "Small tables"',
+                                verbatimTextOutput("attrtbl_sm")
+                                ),
+               conditionalPanel('input.attrview == "Plot summaries"',
                                 tags$label("Type of plots"),
                                 helpText("Density plots will only be created for",
                                          "numeric attributes with more than nine",
@@ -760,7 +763,9 @@ fluidRow(
                                   label = "Download Plot", class = "btn-sm")),
                 conditionalPanel(condition='input.plottabs == "Attributes"',
                                  selectInput("attrview", label = "View attributes in:",
-                                             choices = c("table", "histogram")),
+                                             choices = c("Large table",
+                                                         "Small tables",
+                                                         "Plot summaries")),
                                  br(),
                                  uiOutput("attrcheck")
                 ),