How can I build a long selectInput list and then use it to change the labels in facet_wrap

Question

This question is with reference to This SO question

The above question is regarding changing the labels of a facet_wrap, the answer is perfect --> add a modified label as a new column of the dataset.

Now, the problem I am facing is --

User selects multiple variables selectInput("select", h4("Variables:"), choices=var.both1(), selected=var.both1()[1], multiple=T, width="100%")

(for ex: lets consider input$select length can be 6) now input$select contains six variables, I want to check each variable and assign units to it, and I can partially achieve this with the following reactive component

variableunit <- reactive ({
  if(input$select == "TEPC") {"degC"}
  else if(input$select == "AT"){"µmol/kg"}
  else if(input$select == "DIC" | input$select == "DIN" | input$select == "PIC" | input$select == "POC" | input$select == "PON" | input$select == "POP" | input$select == "DOC" | input$select == "DON" | input$select == "DOP" | input$select == "TEP"){c("µmol/L")}
  else if(input$select == "Chla"){"µg/L"}
  else ("Meters")  
})

the variableunit here gets a single value, even the user enters 6 variable, variableunit can give me only one single value.

how can I have a list of 6 values inside variableunit so that I can use it in the below ggplot facet_wrap

The Code

    server <- function(input, output) {

  a <- reactive({
    fileinput1 <- input$file1
    if (is.null(fileinput1))
      return(NULL)
    read.table(fileinput1$datapath, header = TRUE, col.names = c("Ei","Mi","hours","Nphy","Cphy","CHLphy","Nhet","Chet","Ndet","Cdet","DON","DOC","DIN","DIC","AT","dCCHO","TEPC","Ncocco","Ccocco","CHLcocco","PICcocco","par","Temp","Sal","co2atm","u10","dicfl","co2ppm","co2mol","pH"))
    #read.table(fileinput1$datapath, header = TRUE, col.names =  c("Experiment","Mesocosm","Hour","Nphy","Cphy","CHLphy","Nhet","Chet","Ndet","Cdet","DON","DOC","DIN","DIC","AT","dCCHO","TEPC","Ncocco","Ccocco","CHLcocco","PICcocco","PAR","Temperature","Salinity","CO2atm","u10","DICflux","CO2ppm","CO2mol","pH"))  
    #a$Chla <- a$CHLphy + a$CHLcocco  #Add new columns as per observation data
    #a$PON <- a$Nphy + a$Nhet + a$Ndet + a$Ncocco 
  })

  output$showMapPlot <- renderUI({
{ list(plotOutput("plot",height="100%"), br()) }
  })



  output$select <- renderUI({
    if(!is.null(a())){selectInput("select", h4("Variables:"), choices=names(a()), selected=NULL, multiple=T, width="100%")}
  })


variableunit <- reactive ({
  if(input$select == "TEPC") {"degC"}
  else if(input$select == "AT"){"µmol/kg"}
  else if(input$select == "DIC" | input$select == "DIN" | input$select == "PIC" | input$select == "POC" | input$select == "PON" | input$select == "POP" | input$select == "DOC" | input$select == "DON" | input$select == "DOP" | input$select == "TEP"){c("µmol/L")}
  else if(input$select == "Chla"){"µg/L"}
  else ("Meters")  
})


  plot_4 <- function(var1 = input$select[1], var2 = input$select[2], var3 = input$select[3], var4 = input$select[4], var5 = input$select[5], var6 = input$select[6]) {
    myvars <- c(var1,var2,var3,var4,var5,var6)
    withProgress(message = 'Processing please wait...', value = 0, {
    gg4 <- aggregate(cbind(get(var1),get(var2),get(var3),get(var4),get(var5),get(var6))~Mi+hours,a(), FUN=mean)
    names(gg4)[3] <- var1
    names(gg4)[4] <- var2
    names(gg4)[5] <- var3
    names(gg4)[6] <- var4
    names(gg4)[7] <- var5
    names(gg4)[8] <- var6
    dd <- melt(gg4,id.vars=c("Mi","hours"), measure.vars=myvars)
    dd$label <- paste(as.character(dd$variable), "(", (variableunit()), ")", sep="")
    print(ggplot(dd,aes(x=hours, y=value)) + 
            geom_point(aes(color=factor(Mi)), size = 3, position = position_jitter(width = 0.1))  +
            geom_smooth(stat= "smooth" , alpha = I(0.01), method="loess", color = "blue") +
            facet_wrap(~label, nrow=3, ncol=2,scales = "free_y") + scale_color_discrete("Mesocosm") )
})
  }

  output$plot <- renderPlot({
    if(length(input$select) == 6){
    plot_4() 
    }
},
height=700, width=1100
)
}

ui <- shinyUI(fluidPage(
  fluidRow(column(3,
      uiOutput("showMapPlot"),
      wellPanel(
        h4("Data Upload"),
        fileInput('file1', h5('Choose Your Model Data'), accept=c('text/csv','text/comma-separated-values,text/plain','.OUT'))),
      wellPanel(h4("Variable selection"),uiOutput("select"))

    ),
    column(9,
           tabsetPanel(
             tabPanel("Conditional Plots",plotOutput("plot",height="auto"),value="barplots"),
             id="tsp"))
  )
))

shinyApp(ui = ui, server = server)

File to upload Download here

Just copy paste the code and execute it.

Now the problem is first variables unit is repeating for all other plots. I know this is the problem with the reactive component that I am using to get the units of the variables.

The Question Now is, how to do that ?

I am stuck here from a long time, really hoping somebody knows the workaround. Thanks.

Answer 1

Q:"how can I have a list of 6 values inside variableunit so that I can use it in the below ggplot facet_wrap"

A: You can have list of 6 values inside reactive function. Use for loop to go through input$select. And save corresponding unit to same index in a list.

server <- function(input, output) {

      variableunit <- reactive({
      test <- c("TEPC", "Chla", "DIN", "PIC", "AI", "PON")    
      values <- list()
      for(i in 1:length(test)) {

        if(test[[i]] == "TEPC") {
        values[[i]] <-"degC"
        }else if(test[[i]] == "AT"){
        values[[i]] <-"µmol/kg"
        }else if(test[[i]] == "DIC" | test[[i]] == "DIN" | test[[i]] == "PIC" | test[[i]] == "POC" | test[[i]] == "PON" | test[[i]] == "POP" | test[[i]] == "DOC" | test[[i]] == "DON" | test[[i]] == "DOP" | test[[i]] == "TEP"){
        values[[i]] <-"µmol/L"
        }else if(test[[i]] == "Chla"){
        values[[i]] <-"µg/L"
        }else{
        values[[i]] <-"Meters"
        }   
    }

  return(paste(as.character(test), "(",values,")", sep=""))
})

      output$text <- renderText({
        variableunit()
        print(paste(variableunit()))
      })
    }

    ui <- shinyUI(fluidPage(
      sidebarLayout(
        sidebarPanel(

        ),
        mainPanel(textOutput("text"))
      )
    ))

    shinyApp(ui = ui, server = server)

This example renders text: TEPC(degC) Chla(µg/L) DIN(µmol/L) PIC(µmol/L) AI(Meters) PON(µmol/L)

Answer 2

I have tried with the above answer and I will end up getting this error "Error : nrow * ncol >= n is not TRUE". Please let me know if somebody knows the work around.

server <- function(input, output) {


  #File Upload
  a <- reactive({
    fileinput1 <- input$file1
    if (is.null(fileinput1))
      return(NULL)
    read.table(fileinput1$datapath, header = TRUE, col.names = c("Ei","Mi","hours","Nphy","Cphy","CHLphy","Nhet","Chet","Ndet","Cdet","DON","DOC","DIN","DIC","AT","dCCHO","TEPC","Ncocco","Ccocco","CHLcocco","PICcocco","par","Temp","Sal","co2atm","u10","dicfl","co2ppm","co2mol","pH"))
  })


  #Plot
  output$showMapPlot <- renderUI({
{ list(plotOutput("plot",height="100%"), br()) }
  })


  #Variable Input
  output$select <- renderUI({
    if(!is.null(a())){selectInput("select", h4("Variables:"), choices=names(a())[-c(1,2,3)], selected=NULL, multiple=T, width="100%")}
  })




  #Function to plot the variables
  plot_4 <- function(var1 = input$select[1], var2 = input$select[2], var3 = input$select[3], var4 = input$select[4], var5 = input$select[5], var6 = input$select[6]) {
    myvars <- c(var1,var2,var3,var4,var5,var6)
    withProgress(message = 'Processing please wait...', value = 0, {
    gg4 <- aggregate(cbind(get(var1),get(var2),get(var3),get(var4),get(var5),get(var6))~Mi+hours,a(), FUN=mean)
    names(gg4)[3] <- var1
    names(gg4)[4] <- var2
    names(gg4)[5] <- var3
    names(gg4)[6] <- var4
    names(gg4)[7] <- var5
    names(gg4)[8] <- var6
    dd <- melt(gg4,id.vars=c("Mi","hours"), measure.vars=myvars)


    #Reactive element to get the unit corresponding to the variable entered
    variableunit <- reactive({
      test <- c("TEPC", "Chla", "DIN", "PIC", "AI", "PON")    
      values <- list()
      for(i in 1:length(test)) {

        if(test[[i]] == "TEPC") {
          values[[i]] <-"degC"
          next
        }else if(test[[i]] == "AT"){
          values[[i]] <-"µmol/kg"
          next
        }else if(test[[i]] == "DIC" | test[[i]] == "DIN" | test[[i]] == "PIC" | test[[i]] == "POC" | test[[i]] == "PON" | test[[i]] == "POP" | test[[i]] == "DOC" | test[[i]] == "DON" | test[[i]] == "DOP" | test[[i]] == "TEP"){
          values[[i]] <-"µmol/L"
        }else if(test[[i]] == "Chla"){
          values[[i]] <-"µg/L"
        }else{
          values[[i]] <-"Meters"
        }
      }

      return(values)
      #return(paste(as.character(test), "(",values,")", sep=""))
      #dd$label <- paste(as.character(test), "(",values,")", sep="")
    })

    print(paste(variableunit()))
    dd$label <- paste(as.character(dd$variable), "(", variableunit(), ")", sep="")
    #dd$label <- variableunit()

    print(names(dd))
    #print(unique(dd$variable))
    #print(unique(dd$value))
    print(ggplot(dd,aes(x=hours, y=value)) + 
            geom_point(aes(color=factor(Mi)), size = 3, position = position_jitter(width = 0.1))  +
            geom_smooth(stat= "smooth" , alpha = I(0.01), method="loess", color = "blue") +
            facet_wrap(~label, nrow=3, ncol=2,scales = "free_y") + scale_color_discrete("Mesocosm") )
})
  }

  output$plot <- renderPlot({
    if(length(input$select) == 6){
    plot_4() 
    }
},
height=700, width=1100
)
}

ui <- shinyUI(fluidPage(
  fluidRow(column(3,
      uiOutput("showMapPlot"),
      wellPanel(
        h4("Data Upload"),
        fileInput('file1', h5('Choose Your Model Data'), accept=c('text/csv','text/comma-separated-values,text/plain','.OUT'))),
      wellPanel(h4("Variable selection"),uiOutput("select"))

    ),
    column(9,
           tabsetPanel(
             tabPanel("Conditional Plots",plotOutput("plot",height="auto"),value="barplots"),
             id="tsp"))
  )
))

shinyApp(ui = ui, server = server)

I could not achieve what I wanted with the melted data, but in my case I am doing aggregate of data then melting. So I just changed the data to whatever way I wanted after the aggregate itself and before melting, so all the variable names are now updated and ready to put into facet panels. Below is the code:

server <- function(input, output) {


  #File Upload
  a <- reactive({
    fileinput1 <- input$file1
    if (is.null(fileinput1))
      return(NULL)
    read.table(fileinput1$datapath, header = TRUE, col.names = c("Ei","Mi","hours","Nphy","Cphy","CHLphy","Nhet","Chet","Ndet","Cdet","DON","DOC","DIN","DIC","AT","dCCHO","TEPC","Ncocco","Ccocco","CHLcocco","PICcocco","par","Temp","Sal","co2atm","u10","dicfl","co2ppm","co2mol","pH"))
  })


  #Plot
  output$showMapPlot <- renderUI({
{ list(plotOutput("plot",height="100%"), br()) }
  })


#Variable Input
output$select <- renderUI({
  if(!is.null(a())){selectInput("select", h4("Variables:"), choices=names(a())[-c(1,2,3)], selected=NULL, multiple=T, width="100%")}
})

#Reactive Element to update the units
variableunit <- reactive({
  #test <- c("TEPC", "Chla", "DIN", "PIC", "AI", "PON")    
  test <- input$select
  values <- list()
  for(i in 1:length(test)) {

    if(test[[i]] == "TEPC") {
      values[[i]] <-"degC"
      next
    }else if(test[[i]] == "AT"){
      values[[i]] <-"µmol/kg"
      next
    }else if(test[[i]] == "DIC" | test[[i]] == "DIN" | test[[i]] == "PIC" | test[[i]] == "POC" | test[[i]] == "PON" | test[[i]] == "POP" | test[[i]] == "DOC" | test[[i]] == "DON" | test[[i]] == "DOP" | test[[i]] == "TEP"){
      values[[i]] <-"µmol/L"
    }else if(test[[i]] == "Chla"){
      values[[i]] <-"µg/L"
    }else{
      values[[i]] <-"Meters"
    }
  }

  return(values)
})



#Function to plot the variables
plot_4 <- function(var1 = input$select[1], var2 = input$select[2], var3 = input$select[3], var4 = input$select[4], var5 = input$select[5], var6 = input$select[6]) {
  myvars <- c(var1,var2,var3,var4,var5,var6)
  withProgress(message = 'Processing please wait...', value = 0, {
    gg4 <- aggregate(cbind(get(var1),get(var2),get(var3),get(var4),get(var5),get(var6))~Mi+hours,a(), FUN=mean)
    names(gg4)[3] <- paste(var1,"(",variableunit()[1],")")
    names(gg4)[4] <- paste(var2,"(",variableunit()[2],")")
    names(gg4)[5] <- paste(var3,"(",variableunit()[3],")")
    names(gg4)[6] <- paste(var4,"(",variableunit()[4],")")
    names(gg4)[7] <- paste(var5,"(",variableunit()[5],")")
    names(gg4)[8] <- paste(var6,"(",variableunit()[6],")")
    dd <- melt(gg4,id.vars=c("Mi","hours"), measure.vars=c(names(gg4)[3],names(gg4)[4],names(gg4)[5],names(gg4)[6],names(gg4)[7],names(gg4)[8]))

    print(ggplot(dd,aes(x=hours, y=value)) + 
            geom_point(aes(color=factor(Mi)), size = 3, position = position_jitter(width = 0.1))  +
            geom_smooth(stat= "smooth" , alpha = I(0.01), method="loess", color = "blue") +
            facet_wrap(~variable, nrow=3, ncol=2,scales = "free_y") + scale_color_discrete("Mesocosm") )
  })
}

output$plot <- renderPlot({
  if(length(input$select) == 6){
    plot_4() 
  }
},
height=700, width=1100
)
}

ui <- shinyUI(fluidPage(
  fluidRow(column(3,
                  uiOutput("showMapPlot"),
                  wellPanel(
                    h4("Data Upload"),
                    fileInput('file1', h5('Choose Your Model Data'), accept=c('text/csv','text/comma-separated-values,text/plain','.OUT'))),
                  wellPanel(h4("Variable selection"),uiOutput("select"))

  ),
  column(9,
         tabsetPanel(
           tabPanel("Conditional Plots",plotOutput("plot",height="auto"),value="barplots"),
           id="tsp"))
  )
))

shinyApp(ui = ui, server = server)

If someone knows a way to achieve this after the melting of the data then please let me know. Thanks.