Dynamic rendering of plots & text with multiple input selection

[Artis Pagsanjan]

Gurus,

been frying my brain how i can proceed to update my codes to be able to have the plots & text (aligned in 1 column - as 1 group based selected input) to dynamically update & add beside each other if i set the select input to multiple (with "paramSel"). Meaning, if i select 2 inputs, i expect 2 columns, each have the chart & the text output.

Appreciate your inputs & help here...

  ui = fluidPage(

    titlePanel(title = h2("Process Capability Analysis", align="center")),

    sidebarLayout(

      sidebarPanel(

        h5(tags$img(src="logo.jpg", height=100, width=220)),

        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"),

        width = 2),

    mainPanel(

      tabsetPanel(

        tabPanel("Plots and Summary", br(),

                 plotOutput("charts"),

                 verbatimTextOutput({"lim"}), verbatimTextOutput("avg"),  verbatimTextOutput("mdn"), 

                 verbatimTextOutput("quart"), verbatimTextOutput("stdv"), verbatimTextOutput("cP"),  verbatimTextOutput("cPk")),

        tabPanel("Raw Data", tableOutput("dt"), style = "font-size:70%")

      ), width = 4)

  )),

[Artis Pagsanjan]

I have an updated version trying to apply what i have found so far from some forums (with for lioop).

However, i still have an error when i select more than 2 inputs; working fine for 1 input selection. Hope experts here can guide me... thank you.

library(ggplot2)

library(shiny)

library(cowplot)

library(tidyverse)

shell("cls") # Clear Console

paramj <- 0

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"),

        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) {

    

    # Select data file to load

    df <- 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(df())

    id1 <- unname(which(sapply(df(), is.numeric))) # Numeric 

    my_data <- subset(df(), 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,]})

    

    param <- reactive({

      req(input$param)

      param <- myval()[[input$param]]})

    

    lolim <- reactive({

      req(input$param)

      lolim <- as.numeric(df()[1,][[input$param]])})

    

    hilim <- reactive({

      req(input$param)

      hilim <- as.numeric(df()[2,][[input$param]])})

    

    rval <- reactive({

      req(input$param)

      lolim <- as.numeric(df()[1,][[input$param]])

      hilim <- as.numeric(df()[2,][[input$param]])

      

      ave   <- round(mean(myval()[[input$param]]),digits = 4)

      stdev <- round(sd(myval()[[input$param]]), digits = 4)

      cp    <- round((hilim-lolim)/(6*stdev),digits = 4)

      cpku  <- round((hilim-ave)/(3*stdev),digits = 4)

      cpkl  <- round((ave-lolim)/(3*stdev), digits = 4)

      q1    <- round(as.numeric(unlist(quantile(myval()[[input$param]])))[2], digits = 4)

      q2    <- round(as.numeric(unlist(quantile(myval()[[input$param]])))[3], digits = 4)

      q3    <- round(as.numeric(unlist(quantile(myval()[[input$param]])))[5], digits = 4)

      

      list(ave,q1,q2,q3,stdev,cp,cpkl,cpku)

      })

    output$dt <- renderTable({

      req(input$param)

      df()})

  

    

    output$paramSel <- renderUI({

      req(df())

    selectInput("param", "Test Parameter: ", colnames(myval()), multiple = T)})

    

    output$bPlot <- renderUI({

      req(df())

    checkboxInput("showBP", "Display Boxplot", value = F)})

  

    output$dynaplots <- renderUI({

      req(input$param)

      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)

    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 = "")

        # Chart rendering

        output[[chartnum]] <- renderPlot({

          req(input$param)

          mybin <- input$bin

          dframe <- as.data.frame(myval())

          # Histogram

          hp <-  ggplot(dframe, aes(param())) + geom_histogram(color= "darkslategray", fill="darkseagreen3", bins = mybin) +

            theme(axis.title.y = element_blank(), axis.title.x = element_blank()) + ggtitle(colnames(myval()[input$param])) +

            geom_vline(aes(xintercept=mean(param())), color="blue", linetype="dashed", size=1) +

            geom_vline(data=dframe, aes(xintercept=lolim()), color="red", linetype="dashed", size=1) +

            geom_vline(data=dframe, aes(xintercept=hilim()), color="red", linetype="dashed", size=1)

          

          # Boxplot

          bp <-  ggplot(dframe, aes(param())) + 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=dframe, aes(xintercept=lolim()), color="red", linetype="dashed", size=1) +

            geom_vline(data=dframe, aes(xintercept=hilim()), 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)

          paste("LIMITS         Lower   :", lolim(), "      Upper   :", hilim())})

        

        output[[avgnum]] <- renderText({

          req(input$param)

          paste("MEAN                   :", rval()[1])})

        

        output[[stdvnum]] <- renderText({

          req(input$param)

          paste("STD DEVIATION          :", rval()[5])})

        

        output[[cPnum]] <- renderText({

          req(input$param)

          paste("CP                     :", rval()[6])})

        

        output[[cPknum]] <- renderText({

          req(input$param)

          paste("CPK            Lower   :", rval()[7], "    Upper   :", rval()[8])})

        

        output[[quartnum]] <- renderText({

          req(input$param)

          paste("QUARTILES          Q1  :", rval()[2], "   Q2  :", rval()[3], "    Q3  :", rval()[4])})

        

        

      })

    }})

    

  }

)Enter code here...