将新列添加到数据框并根据闪亮的小部件选择相应地重命名它们

Question

我有下面这个闪亮的应用程序，我希望用户从输入中 select 1 到 3 个选择，然后将相关向量添加到现有数据帧 graph1.data 作为新列。

例如，如果他select选择了所有 3 个选项，他应该有一个包含 6 个新列的数据框。但是在这种情况下，这些列应该命名为 x,y,x1,y1,x2,y2 而不是向量名称，而不管首先选择哪个 select。例如，如果 Gross Sales 首先被 select 编辑，那么 GrossSalesx2 应该是 x 而 GrossSalesy2 应该是 y.

## app.R ##
library(shiny)
library(shinydashboard)
#library(plotly)
library(tidyr)
library(dplyr)
library(DT)
BRAND<-c("CHOKIS","CHOKIS","CHOKIS","CHOKIS","CHOKIS","CHOKIS","LARA CHOCO CHIPS","LARA CHOCO CHIPS","LARA CHOCO CHIPS")
BRAND_COLOR<-c("#8050f0","#8050f0","#8050f0","#8050f0","#8050f0","#8050f0","#f050c0","#f050c0","#f050c0")

SellOut.x<-c(23,34,56,77,78,34,34,64,76)
SellOut.y<-c(43,54,76,78,87,98,76,76,56)
GrossProfit.x1<-c(23,34,56,75,78,34,34,64,76)
GrossProfit.y1<-c(33,54,76,76,87,98,76,76,56)
GrossSales.x2<-c(53,34,56,77,78,34,34,84,76)
GrossSales.y2<-c(63,54,76,78,87,98,76,76,86)
r<-c(58,46,76,76,54,21,69,98,98)


graph1.data<-data.frame(BRAND,r)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    selectInput("metric","Metric",c('Gross Sales','Gross Profit','Sell Out'),multiple = T,selected = "Sell Out")
  ),
  dashboardBody(
    DTOutput("df")
  )
)

server <- function(input, output) {

  output$df<-renderDT({})

}

shinyApp(ui, server)

Answer 1

尝试以下方法：

library(shiny)
library(shinydashboard)
#library(plotly)
library(tidyr)
library(dplyr)
library(DT)
BRAND<-c("CHOKIS","CHOKIS","CHOKIS","CHOKIS","CHOKIS","CHOKIS","LARA CHOCO CHIPS","LARA CHOCO CHIPS","LARA CHOCO CHIPS")
BRAND_COLOR<-c("#8050f0","#8050f0","#8050f0","#8050f0","#8050f0","#8050f0","#f050c0","#f050c0","#f050c0")

SellOut.x<-c(23,34,56,77,78,34,34,64,76)
SellOut.y<-c(43,54,76,78,87,98,76,76,56)
GrossProfit.x1<-c(23,34,56,75,78,34,34,64,76)
GrossProfit.y1<-c(33,54,76,76,87,98,76,76,56)
GrossSales.x2<-c(53,34,56,77,78,34,34,84,76)
GrossSales.y2<-c(63,54,76,78,87,98,76,76,86)
r<-c(58,46,76,76,54,21,69,98,98)

graph1.data<-data.frame(BRAND,r)

# data frame containing columns to be added
df6 <- data.frame(SellOut.x, SellOut.y, GrossProfit.x1, GrossProfit.y1, GrossSales.x2, GrossSales.y2) 

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    selectInput("metric","Metric",c('Gross Sales','Gross Profit','Sell Out'),multiple = T,selected = "Sell Out")
  ),
  dashboardBody(
    verbatimTextOutput("selections"), # optional
    DTOutput("df")
  )
)

server <- function(input, output) {
  

  
  choices <- reactive({
   c3 <- gsub(" ", "", input$metric) # remove space
   
   return(c3)
  })
  
  reactiveDf <- reactive({
    if(length(choices()) > 0){
      # if choices match column names of df6
      g1 <- apply(sapply(X = choices(), FUN = grepl, colnames(df6)), MARGIN =  1, FUN = any)
      
      addedDf <- df6[, g1] # columns to be added
      colnames(addedDf) <- c("x", "y", "x1", "y1", "x2", "y2")[1:ncol(addedDf)] # change column names
      
      combinedDf <- cbind(graph1.data, addedDf) # add columns
      return(combinedDf)
    }else{
      return(graph1.data) 
    }
    
    
  })
  
  output$selections<- renderPrint({
    choices()
  })
  
  output$df<-renderDT({
    reactiveDf()
  })
  
}

shinyApp(ui, server)

将新列添加到数据框并根据闪亮的小部件选择相应地重命名它们

Add new columns to a dataframe and rename them accordingly based on shiny widget selections

r

shiny