Показать уникальное значение столбцов в Shinydashboard - PullRequest
0 голосов
/ 25 апреля 2018

Я хочу отобразить таблицу (с именем столбца, числом уникальных значений, уникальным значением) для набора данных с нулевой дисперсией (число уникальных значений = <1).Но когда я запускаю этот код в виде «блеска», я получаю эту ошибку. </p>

Предупреждение: ошибка в: аргументы подразумевают различное количество строк: 2, 5, 3, 6

Example output

library(shiny)
library(shinydashboard)
library(DT)
library(caret)

ui <- dashboardPage(
   skin = "black",
   dashboardHeader(title = "data"),
   dashboardSidebar(
      sidebarMenu(
         fileInput("Table1", "Historical Data"),
         radioButtons("sep", "Separator", choices = c(Comma = ",", Semicolon = ";", 
         Tab = "\t", Pipe="|"), selected = ","),
            menuItem("Data Overview", tabName = "data_view", icon = icon("table"))
       )
    ),
   dashboardBody(
      tabItems(
         tabItem(tabName = "data_view",
            fluidRow(
               box(title = "Zero Variance Variables", width = 12, solidHeader = TRUE,
               status = "primary", collapsible = TRUE, DT::DTOutput("uniq_data")))
             )
        )
    )
)

server <- function(input, output, session) { 

  ## initialize
  rv <- reactiveValues()

  ## update when dataset changes
  observe({
    rv$Train <- read.table(req(input$Table1)$datapath, fill = TRUE, header = TRUE, 
                           sep=input$sep, na.strings = c(""," ", NA), 
                           stringsAsFactors = TRUE)
  }) 

  col_uniq <- reactive({

    nzv <- nearZeroVar(rv$Train)
    df1 <- rv$Train[, nzv] 

    d <- data.frame(names(df1), sapply(df1, function(x) length(unique(x[!is.na(x)]))))
    names(d) <- c("Variable", "No. of Uniques") 

    as <- sapply(df1, function(x) length(unique(x))) > 1
    as1 <- df1[, as]

    as2 <- data.frame(names(as1),sapply(as1, function(x) unique(x)))
    names(as2) <- c("Variable", "Unique Value")

    join <- merge(d, as2, by.x = "Variable", by.y = "Variable", all.x = TRUE)

    return(join)
  })

  output$uniq_data <- DT::renderDT({
    dclas <- DT::datatable(col_uniq(), options = list(scrollX = TRUE))
  })
}
shinyApp(ui, server)  

Спасибо, Баладжи

...