將新列添加到數據框並根據閃亮的小部件選擇相應地重命名它們

Question

我有下面的閃亮應用程序，我希望用戶從輸入中選擇 1 到 3 個選項，然后將相關向量添加到現有數據graph1.data作為新列。

例如，如果他選擇了所有 3 個選項，他應該有一個包含 6 個新列的數據框。 但是，在這種情況下，無論首先選擇哪個選項，這些列都應該命名為x,y,x1,y1,x2,y2而不是向量名稱。 例如，如果首先選擇Gross Sales ，則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)