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

Question

This question is related to This Question SO

The above question is about changing facet_wrap labels, the answer is fine -> add the changed label as a new column in the dataset.

Now the problem I am facing is

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

(for example: let the length of input$select be 6) now input$select contains six variables, I want to check each variable and assign units to it, and I can partially do 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") }) 

variableunit gets one value here, even if the user enters 6 variables, variableunit can only give me one value.

how can i get a list of 6 values ​​inside variableunit so i can use it in ggplot facet_wrap below

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) 

Download file Download here

Just copy the code and run it.

Now the problem is the first unit of variables repeated for all other graphs. I know that this is a problem with the reactive component that I use to get units of variables.

Question Now, how to do this?

I have been stuck here for a long time, really hoping that someone knows a workaround. Thanks.

Answer 1

I tried with the answer above and I will get this error . Error: nrow * ncol> = n is not TRUE . " Please let me know if anyone knows about this.

 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 molten data, but in my case I am doing a collection of data, then melting. Therefore, I just changed the data as I wanted, after the aggregate itself and before melting, so all the variable names are now updated and ready to be placed in the facet panel. 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 anyone knows a way to achieve this after the data has melted, please let me know. Thanks.

Answer 2

Q: "How can I get a list of 6 values ​​inside a variable so that I can use it in the ggplot facet_wrap below"

A: You can have a list of 6 values ​​inside a reactive function. Use for loop to go through input$select . And save the corresponding block in the same index in the 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 displays the text: TEPC (degC) Chla (µg / L) DIN (µmol / L) PIC (µmol / L) AI (meters) PON (µmol / L)