Отказ блестящей реактивности, когда на блестящей приборной панели есть два элемента табуляции - PullRequest
0 голосов
/ 28 мая 2018

Ниже приведен кодовый набор, в котором вы можете видеть, что у tabitem есть два tabitem, dash и out.Когда я заканчиваю свою панель инструментов на второй вкладке («out» или «Outlier Flagging»), используемые слайсеры не работают.Пожалуйста, помогите.

library(shiny)
library(shinydashboard)
library(ggplot2)
library(dplyr)
library(DT)

Загрузка ссуды набора данных

loan.v <- read.csv("D:\\rstudio\\shiny\\loan\\loan.v.csv")

#Define UI shiny dashboard
ui <- dashboardPage(
  dashboardHeader(title = "Bank Report Sheet"),
  dashboardSidebar(
    #Define Sidebar Content
    sidebarMenu(
      menuItem("Dashboard",
               tabName = "dash",
               icon = icon("dashboard")),
      menuItem("Oultlier Flagging",
               tabName = "out",
               icon = icon("exclamation"))
    )
  ),
  dashboardBody(
    tabItems(
      #Dashboard Content
      tabItem(tabName = "dash",
              h2("Histogram"),
              fluidPage(
                sidebarLayout(
                  sidebarPanel(
                    # Select variable for y-axis
                    radioButtons(inputId = "x", 
                                 label = "Scalar Features in Loan Portfolio",
                                 choices = c("Annual Income" = "annual_inc",
                                             "Loan Amount" = "loan_amnt", 
                                             "Funded Amount" = "funded_amnt", 
                                             "Open Account" = "open_acc",
                                             "Total Account" = "total_acc",
                                             "Revolving Balance" = "revol_bal",
                                             "Revolving Utilization" = "revol_util"), 
                                 selected = "funded_amnt"), #using parameters of the loan file
                    #Slider Bins
                    sliderInput(inputId = "bins",
                                label = "Number of bins",
                                min = 1,
                                max = 50,
                                value = 28,
                                step = 1),
                    #Filter by Risk grade
                    selectInput(inputId = "filter_g",
                                label = "Filter by Levels of Risk Grades",
                                choices = c("All Levels" = " " , levels(loan.v$grade)),
                                selected = " ")
                  ),
                  #output
                  mainPanel(
                    plotOutput(outputId = "histo"),
                    verbatimTextOutput("sum")
                  )
                )
              )),
      #Outlier content
      tabItem(tabName = "out",
              h2("Outlier flagging using outlier test"),
              fluidPage(
                sidebarLayout(
                  sidebarPanel(
                    #Variables to test for outliers
                    radioButtons(inputId = "x", 
                                 label = "Scalar Features in Loan Portfolio",
                                 choices = c("Annual Income" = "annual_inc",
                                             "Loan Amount" = "loan_amnt", 
                                             "Funded Amount" = "funded_amnt", 
                                             "Open Account" = "open_acc",
                                             "Total Account" = "total_acc",
                                             "Revolving Balance" = "revol_bal",
                                             "Revolving Utilization" = "revol_util"), 
                                 selected = "funded_amnt"),
                    #Filter by Risk grade
                    selectInput(inputId = "filter_g",
                                label = "Filter by Levels of Risk Grades",
                                choices = c("All Levels" = " " , levels(loan.v$grade)),
                                selected = " ")
                  ),
                  #Output
                  mainPanel(
                    plotOutput(outputId = "box"),
                    DT::dataTableOutput(outputId = "tab")
                  ))
              )
      )

    )
  )
)

#Definr server function
server <- function(input, output) {
  #Create Histogram
  output$histo <- renderPlot({
    if(input$x == "annual_inc") {
      i <- 1
    }
    if(input$x == "loan_amnt") {
      i <- 3
    }
    if(input$x == "funded_amnt") {
      i <- 5
    }
    if(input$x == "open_acc") {
      i <- 7
    }
    if(input$x == "total_acc") {
      i <- 8
    }
    if(input$x == "revol_bal") {
      i <- 10
    }
    if(input$x == "revol_util") {
      i <- 11
    }

    if(input$filter_g == "A") {
      x <- subset(loan.v, subset = loan.v$grade == "A")[ , i]
    }
    if(input$filter_g == "B") {
      x <- subset(loan.v, subset = loan.v$grade== "B")[ , i]
    }
    if(input$filter_g == "C") {
      x <- subset(loan.v, subset = loan.v$grade== "C")[ , i]
    }
    if(input$filter_g == "D") {
      x <- subset(loan.v, subset = loan.v$grade== "D")[ , i]
    }
    if(input$filter_g == "E") {
      x <- subset(loan.v, subset = loan.v$grade== "E")[ , i]
    }
    if(input$filter_g == "F") {
      x <- subset(loan.v, subset = loan.v$grade== "F")[ , i]
    }
    if(input$filter_g == "G") {
      x <- subset(loan.v, subset = loan.v$grade== "G")[ , i]
    }
    if(input$filter_g == " ") {
      x <- loan.v[ , i]
    }

    bins <- seq(min(x), max(x), length.out = input$bins +1)
    hist(x, breaks = input$bins, col = "steelblue", border = "white",
         xlab = input$x,
         main = paste0("Histogram of ", input$x))

  })
  #Create summary output
  output$sum <- renderPrint({
    if(input$filter_g == "A") {
      x <- subset(loan.v, subset = loan.v$grade == "A")
    }
    if(input$filter_g == "B") {
      x <- subset(loan.v, subset = loan.v$grade== "B")
    }
    if(input$filter_g == "C") {
      x <- subset(loan.v, subset = loan.v$grade== "C")
    }
    if(input$filter_g == "D") {
      x <- subset(loan.v, subset = loan.v$grade== "D")
    }
    if(input$filter_g == "E") {
      x <- subset(loan.v, subset = loan.v$grade== "E")
    }
    if(input$filter_g == "F") {
      x <- subset(loan.v, subset = loan.v$grade== "F")
    }
    if(input$filter_g == "G") {
      x <- subset(loan.v, subset = loan.v$grade== "G")
    }
    if(input$filter_g == " ") {
      x <- loan.v
    }

    summary(x)
  })
  #Create Box plot
  output$box <- renderPlot({
    if(input$x == "annual_inc") {
      i <- 1
    }
    if(input$x == "loan_amnt") {
      i <- 3
    }
    if(input$x == "funded_amnt") {
      i <- 5
    }
    if(input$x == "open_acc") {
      i <- 7
    }
    if(input$x == "total_acc") {
      i <- 8
    }
    if(input$x == "revol_bal") {
      i <- 10
    }
    if(input$x == "revol_util") {
      i <- 11
    }

    if(input$filter_g == "A") {
      x <- subset(loan.v, subset = loan.v$grade == "A")[ , i]
    }
    if(input$filter_g == "B") {
      x <- subset(loan.v, subset = loan.v$grade== "B")[ , i]
    }
    if(input$filter_g == "C") {
      x <- subset(loan.v, subset = loan.v$grade== "C")[ , i]
    }
    if(input$filter_g == "D") {
      x <- subset(loan.v, subset = loan.v$grade== "D")[ , i]
    }
    if(input$filter_g == "E") {
      x <- subset(loan.v, subset = loan.v$grade== "E")[ , i]
    }
    if(input$filter_g == "F") {
      x <- subset(loan.v, subset = loan.v$grade== "F")[ , i]
    }
    if(input$filter_g == "G") {
      x <- subset(loan.v, subset = loan.v$grade== "G")[ , i]
    }
    if(input$filter_g == " ") {
      x <- loan.v[ , i]
    }

    boxplot(x)

  })

  #Create table
  output$tab <- DT::renderDataTable({

    if(input$filter_g == "A") {
      x <- subset(loan.v, subset = loan.v$grade == "A")
    }
    if(input$filter_g == "B") {
      x <- subset(loan.v, subset = loan.v$grade== "B")
    }
    if(input$filter_g == "C") {
      x <- subset(loan.v, subset = loan.v$grade== "C")
    }
    if(input$filter_g == "D") {
      x <- subset(loan.v, subset = loan.v$grade== "D")
    }
    if(input$filter_g == "E") {
      x <- subset(loan.v, subset = loan.v$grade== "E")
    }
    if(input$filter_g == "F") {
      x <- subset(loan.v, subset = loan.v$grade== "F")
    }
    if(input$filter_g == "G") {
      x <- subset(loan.v, subset = loan.v$grade== "G")
    }
    if(input$filter_g == " ") {
      x <- loan.v
    }
    if(input$x == "annual_inc") {
      i <- 1
    }
    if(input$x == "loan_amnt") {
      i <- 3
    }
    if(input$x == "funded_amnt") {
      i <- 5
    }
    if(input$x == "open_acc") {
      i <- 7
    }
    if(input$x == "total_acc") {
      i <- 8
    }
    if(input$x == "revol_bal") {
      i <- 10
    }
    if(input$x == "revol_util") {
      i <- 11
    }
    #Using business ruls: Items that are more than 3 standard deviations from the mean are flagged
    y <- x[ , i]
    m_x <- mean(y, na.rm = TRUE)
    s_x <- sd(y, na.rm = TRUE)
    tab_t <- subset(x, subset = y > m_x + 3*s_x | y < m_x - 3*s_x)
    DT::datatable(data = tab_t,
                  options = list(pageLength = 20),
                  rownames = FALSE)
  })
}

#Define Shiny App
shinyApp(ui, server)

На следующих изображениях показаны случаи, когда срезы работали и не работали

Слайсеры работаютв этом случае В этом случае срезы не работают

...