Ниже приведен кодовый набор, в котором вы можете видеть, что у 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)
На следующих изображениях показаны случаи, когда срезы работали и не работали
Слайсеры работаютв этом случае В этом случае срезы не работают