I have multiple selectinput & based on the selected inputs, trying to dynamically render plots & tables.
It works fine if i just selected 1 input, but getting error "subset2: subscript out of bounds" once i select more than 1 inputs. Appreciate the community's expert inputs.
Below is the code i am working on:
R code <<<<
library(ggplot2)
library(shiny)
library(cowplot)
library(tidyverse)
shell("cls") # Clear Console
shinyApp(
User interface
ui = fluidPage(
titlePanel(title = h2("Process Capability Analysis", align="center")),
sidebarLayout(
sidebarPanel(
h5(tags$img(src="logo.jpg", height=100, width=240)),
tags$hr(),
fileInput("datafile", "Load CSV data to analyse:"),
tags$hr(),
sliderInput("bin", "Adjust Histogram Binwidth :",
min=40, max=200, value=100, step=10),
tags$hr(),
uiOutput("paramSel"),
tags$hr(),
uiOutput("bPlot"),
tags$hr(),
uiOutput("refbutton"),
width = 2),
mainPanel(
tabsetPanel(
tabPanel("Plots and Summary", br(),
uiOutput("dynaplots")),
tabPanel("Raw Data", tableOutput("dt"), style = "font-size:70%")
), width = 10)
)),
Underlying reactive codes based on user input
server = function(input, output) {
output$paramSel <- renderUI({
req(dataf())
selectInput("param", "Test Parameter: ", colnames(myval()), multiple = T)})
output$bPlot <- renderUI({
req(dataf())
checkboxInput("showBP", "Display Boxplot", value = F)})
output$refbutton <- renderUI({
actionButton("refresh", "Refresh Plots")
})
# Select data file to load
dataf <- reactive({
dfile <- input$datafile
req(dfile)
read.csv(file = dfile$datapath)})
# Remove invalid columns from the data set based on certain criteria
myval <- reactive({
req(dataf())
id1 <- unname(which(sapply(dataf(), is.numeric))) # Numeric
my_data <- subset(dataf(), select = c(id1))
withNA <- apply(my_data, 1, function(x) any(is.na(x)))
if(withNA){
id2 <- unname(which(sapply(my_data, is.na)))
my_data <- subset(my_data, select = -c(id2))}
newcol <- ncol(my_data)
id3 <- NULL
for (i in 1:newcol){
if (my_data[1,i]-my_data[2,i])
{id3 <- append(id3, i)
}}
my_data <- subset(my_data, select = c(id3))
rowcount <- nrow(my_data)
my_values <- my_data[3:rowcount,]
return(my_values)})
para <- reactive({
req(input$param)
para <- colnames(myval()[[input$param]])
return(para)})
lolim <- reactive({
req(input$param)
lolim <- as.numeric(dataf()[1,][[input$param]])
return(lolim)})
hilim <- reactive({
req(input$param)
hilim <- as.numeric(dataf()[2,][[input$param]])
return(hilim)})
output$dt <- renderTable({
req(input$datafile)
dataf()})
output$dynaplots <- renderUI({
req(input$param, input$refresh)
n <- length(input$param)
dynaplotlist <- lapply(1:n, function(j){
chartnum <- paste("charts", j, sep = "")
limnum <- paste("lim", j, sep = "")
avgnum <- paste("avg", j, sep = "")
stdvnum <- paste("stdv", j, sep = "")
cPnum <- paste("cP", j, sep = "")
cPknum <- paste("cPk", j, sep = "")
quartnum <- paste("quart", j, sep = "")
fluidRow(
column(8, plotOutput(chartnum)),
br(),
br(),
br(),
column(4, verbatimTextOutput(limnum)),
column(4, verbatimTextOutput(avgnum)),
column(4, verbatimTextOutput(stdvnum)),
column(4, verbatimTextOutput(cPnum)),
column(4, verbatimTextOutput(cPknum)),
column(4, verbatimTextOutput(quartnum)),
)})
do.call(tagList, dynaplotlist)
})
observe({
n <- length(input$param)
mybin <- input$bin
mval <- myval()[input$param]
ll <- lolim()
hl <- hilim()
for (j in 1:n) {
local({
chartnum <- paste("charts", j, sep = "")
limnum <- paste("lim", j, sep = "")
avgnum <- paste("avg", j, sep = "")
stdvnum <- paste("stdv", j, sep = "")
cPnum <- paste("cP", j, sep = "")
cPknum <- paste("cPk", j, sep = "")
quartnum <- paste("quart", j, sep = "")
ave <- round(mean(mval[,j]),digits = 4)
stdev <- round(sd(mval[,j]), digits = 4)
cp <- round((hl[j]-ll[j])/(6*stdev),digits = 4)
cpku <- round((hl[j]-ave)/(3*stdev),digits = 4)
cpkl <- round((ave-ll[j])/(3*stdev), digits = 4)
q1 <- round(as.numeric(unlist(quantile(mval[,j])))[2], digits = 4)
q2 <- round(as.numeric(unlist(quantile(mval[,j])))[3], digits = 4)
q3 <- round(as.numeric(unlist(quantile(mval[,j])))[5], digits = 4)
# Chart rendering
output[[chartnum]] <- renderPlot({
req(input$param, input$refresh)
# Histogram
hp <- ggplot(mval, aes(mval[,j])) + geom_histogram(color= "darkslategray", fill="darkseagreen3", bins = mybin) +
theme(axis.title.y = element_blank(), axis.title.x = element_blank()) + ggtitle(colnames(mval[j])) +
geom_vline(aes(xintercept=mean(mval[,j])), color="blue", linetype="dashed", size=1) +
geom_vline(data=mval, aes(xintercept=ll[j]), color="red", linetype="dashed", size=1) +
geom_vline(data=mval, aes(xintercept=hl[j]), color="red", linetype="dashed", size=1)
# Boxplot
bp <- ggplot(mval, aes(mval[,j])) + geom_boxplot(color= "darkslategray", fill="darkseagreen3", outlier.color = "darkmagenta") +
theme(axis.title.y = element_blank(), axis.text.y = element_blank(), title = element_blank()) +
stat_boxplot(geom = 'errorbar', width=0.2, color="darkslategray") +
geom_vline(data=mval, aes(xintercept=ll[j]), color="red", linetype="dashed", size=1) +
geom_vline(data=mval, aes(xintercept=hl[j]), color="red", linetype="dashed", size=1)
# Align charts
if(input$showBP){
plot_grid(hp, bp, ncol = 1, align = "v", axis = "bt")}
else
{plot_grid(hp, ncol = 1, align = "v", axis = "bt")}
})
# Statistics summary rendering
output[[limnum]] <- renderText({
req(input$param, input$refresh)
paste("LIMITS Lower :", ll[j], " Upper :", hl[j])})
output[[avgnum]] <- renderText({
req(input$param, input$refresh)
paste("MEAN :", ave)})
output[[stdvnum]] <- renderText({
req(input$param, input$refresh)
paste("STD DEVIATION :", stdev)})
output[[cPnum]] <- renderText({
req(input$param, input$refresh)
paste("CP :", cp)})
output[[cPknum]] <- renderText({
req(input$param, input$refresh)
paste("CPK Lower :", cpkl, " Upper :", cpku)})
output[[quartnum]] <- renderText({
req(input$param, input$refresh)
paste("QUARTILES Q1 :", q1, " Q2 :", q2, " Q3 :", q3)})
})
}})
}
)
End of R code