如何构建一个长的selectInput列表,然后使用它来更改facet_wrap中的标签

Question

这个问题是参考这个问题

上面的问题是关于更改facet_wrap的标签,答案是完美的 - >添加修改后的标签作为数据集的新列.

现在,我面临的问题是 -

用户选择多个变量 selectInput("select", h4("Variables:"), choices=var.both1(), selected=var.both1()[1], multiple=T, width="100%")

(例如:让我们考虑input$select长度可以是6)现在input$select包含六个变量,我想检查每个变量并为其分配单位,我可以通过以下反应组件部分实现这一点

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这里得到一个值,即使用户进入6变量,variableunit可以给我只有一个单一的价值.

如何在内部列出6个值,variableunit以便我可以在下面的ggplot facet_wrap中使用它

代码

    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)

要上传的文件在 此处下载

只需复制粘贴代码并执行即可.

现在问题 是第一个变量单元正在重复所有其他图.我知道这是我用来获取变量单位的反应组件的问题.

问题 现在是,怎么做？

很长一段时间我被困在这里,真的希望有人知道解决方法.谢谢.

Answer 1

我尝试过上述答案，但最终会收到此错误“Error : nrow * ncol >= n is not TRUE”。如果有人知道解决办法，请告诉我。

\n\n

server <- function(input, output) {\n\n\n  #File Upload\n  a <- reactive({\n    fileinput1 <- input$file1\n    if (is.null(fileinput1))\n      return(NULL)\n    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"))\n  })\n\n\n  #Plot\n  output$showMapPlot <- renderUI({\n{ list(plotOutput("plot",height="100%"), br()) }\n  })\n\n\n  #Variable Input\n  output$select <- renderUI({\n    if(!is.null(a())){selectInput("select", h4("Variables:"), choices=names(a())[-c(1,2,3)], selected=NULL, multiple=T, width="100%")}\n  })\n\n\n\n\n  #Function to plot the variables\n  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]) {\n    myvars <- c(var1,var2,var3,var4,var5,var6)\n    withProgress(message = \'Processing please wait...\', value = 0, {\n    gg4 <- aggregate(cbind(get(var1),get(var2),get(var3),get(var4),get(var5),get(var6))~Mi+hours,a(), FUN=mean)\n    names(gg4)[3] <- var1\n    names(gg4)[4] <- var2\n    names(gg4)[5] <- var3\n    names(gg4)[6] <- var4\n    names(gg4)[7] <- var5\n    names(gg4)[8] <- var6\n    dd <- melt(gg4,id.vars=c("Mi","hours"), measure.vars=myvars)\n\n\n    #Reactive element to get the unit corresponding to the variable entered\n    variableunit <- reactive({\n      test <- c("TEPC", "Chla", "DIN", "PIC", "AI", "PON")    \n      values <- list()\n      for(i in 1:length(test)) {\n\n        if(test[[i]] == "TEPC") {\n          values[[i]] <-"degC"\n          next\n        }else if(test[[i]] == "AT"){\n          values[[i]] <-"\xc2\xb5mol/kg"\n          next\n        }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"){\n          values[[i]] <-"\xc2\xb5mol/L"\n        }else if(test[[i]] == "Chla"){\n          values[[i]] <-"\xc2\xb5g/L"\n        }else{\n          values[[i]] <-"Meters"\n        }\n      }\n\n      return(values)\n      #return(paste(as.character(test), "(",values,")", sep=""))\n      #dd$label <- paste(as.character(test), "(",values,")", sep="")\n    })\n\n    print(paste(variableunit()))\n    dd$label <- paste(as.character(dd$variable), "(", variableunit(), ")", sep="")\n    #dd$label <- variableunit()\n\n    print(names(dd))\n    #print(unique(dd$variable))\n    #print(unique(dd$value))\n    print(ggplot(dd,aes(x=hours, y=value)) + \n            geom_point(aes(color=factor(Mi)), size = 3, position = position_jitter(width = 0.1))  +\n            geom_smooth(stat= "smooth" , alpha = I(0.01), method="loess", color = "blue") +\n            facet_wrap(~label, nrow=3, ncol=2,scales = "free_y") + scale_color_discrete("Mesocosm") )\n})\n  }\n\n  output$plot <- renderPlot({\n    if(length(input$select) == 6){\n    plot_4() \n    }\n},\nheight=700, width=1100\n)\n}\n\nui <- shinyUI(fluidPage(\n  fluidRow(column(3,\n      uiOutput("showMapPlot"),\n      wellPanel(\n        h4("Data Upload"),\n        fileInput(\'file1\', h5(\'Choose Your Model Data\'), accept=c(\'text/csv\',\'text/comma-separated-values,text/plain\',\'.OUT\'))),\n      wellPanel(h4("Variable selection"),uiOutput("select"))\n\n    ),\n    column(9,\n           tabsetPanel(\n             tabPanel("Conditional Plots",plotOutput("plot",height="auto"),value="barplots"),\n             id="tsp"))\n  )\n))\n\nshinyApp(ui = ui, server = server)\n

\n\n

我无法通过熔化的数据实现我想要的目标，但就我而言，我正在聚合数据然后熔化。因此，我只是在聚合本身之后和熔化之前将数据更改为我想要的任何方式，因此所有变量名称现在都已更新并准备好放入构面面板中。\n以下是代码：

\n\n

server <- function(input, output) {\n\n\n  #File Upload\n  a <- reactive({\n    fileinput1 <- input$file1\n    if (is.null(fileinput1))\n      return(NULL)\n    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"))\n  })\n\n\n  #Plot\n  output$showMapPlot <- renderUI({\n{ list(plotOutput("plot",height="100%"), br()) }\n  })\n\n\n#Variable Input\noutput$select <- renderUI({\n  if(!is.null(a())){selectInput("select", h4("Variables:"), choices=names(a())[-c(1,2,3)], selected=NULL, multiple=T, width="100%")}\n})\n\n#Reactive Element to update the units\nvariableunit <- reactive({\n  #test <- c("TEPC", "Chla", "DIN", "PIC", "AI", "PON")    \n  test <- input$select\n  values <- list()\n  for(i in 1:length(test)) {\n\n    if(test[[i]] == "TEPC") {\n      values[[i]] <-"degC"\n      next\n    }else if(test[[i]] == "AT"){\n      values[[i]] <-"\xc2\xb5mol/kg"\n      next\n    }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"){\n      values[[i]] <-"\xc2\xb5mol/L"\n    }else if(test[[i]] == "Chla"){\n      values[[i]] <-"\xc2\xb5g/L"\n    }else{\n      values[[i]] <-"Meters"\n    }\n  }\n\n  return(values)\n})\n\n\n\n#Function to plot the variables\nplot_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]) {\n  myvars <- c(var1,var2,var3,var4,var5,var6)\n  withProgress(message = \'Processing please wait...\', value = 0, {\n    gg4 <- aggregate(cbind(get(var1),get(var2),get(var3),get(var4),get(var5),get(var6))~Mi+hours,a(), FUN=mean)\n    names(gg4)[3] <- paste(var1,"(",variableunit()[1],")")\n    names(gg4)[4] <- paste(var2,"(",variableunit()[2],")")\n    names(gg4)[5] <- paste(var3,"(",variableunit()[3],")")\n    names(gg4)[6] <- paste(var4,"(",variableunit()[4],")")\n    names(gg4)[7] <- paste(var5,"(",variableunit()[5],")")\n    names(gg4)[8] <- paste(var6,"(",variableunit()[6],")")\n    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]))\n\n    print(ggplot(dd,aes(x=hours, y=value)) + \n            geom_point(aes(color=factor(Mi)), size = 3, position = position_jitter(width = 0.1))  +\n            geom_smooth(stat= "smooth" , alpha = I(0.01), method="loess", color = "blue") +\n            facet_wrap(~variable, nrow=3, ncol=2,scales = "free_y") + scale_color_discrete("Mesocosm") )\n  })\n}\n\noutput$plot <- renderPlot({\n  if(length(input$select) == 6){\n    plot_4() \n  }\n},\nheight=700, width=1100\n)\n}\n\nui <- shinyUI(fluidPage(\n  fluidRow(column(3,\n                  uiOutput("showMapPlot"),\n                  wellPanel(\n                    h4("Data Upload"),\n                    fileInput(\'file1\', h5(\'Choose Your Model Data\'), accept=c(\'text/csv\',\'text/comma-separated-values,text/plain\',\'.OUT\'))),\n                  wellPanel(h4("Variable selection"),uiOutput("select"))\n\n  ),\n  column(9,\n         tabsetPanel(\n           tabPanel("Conditional Plots",plotOutput("plot",height="auto"),value="barplots"),\n           id="tsp"))\n  )\n))\n\nshinyApp(ui = ui, server = server)\n

\n\n

如果有人知道在数据熔化后实现此目的的方法，请告诉我。谢谢。

\n