使用闪亮的renderUI在条件选项卡中动态生成绘图

时间:2016-09-27 22:02:11

标签: r shiny

我需要一些帮助来创建动态标签内的动态图。这是情况......我有一个包含数字营销数据的数据文件。该文件包含以下信息:广告系列名称,渠道名称,网页浏览量和访问次数。广告系列名称是唯一的,可以汇总到四个不同的营销渠道之一。这将在未来发生变化,具体取决于我提供的数据(例如,我可能在我使用的下一个文件中有六个营销渠道),但这样做可以用于故障排除。我想为文件中的每个营销渠道动态创建标签和输出。我已经能够弄清楚如何创建选项卡,但我很难弄清楚如何创建其他类型的输出(如图)以与每个选项卡一起使用。

使用服务器文件中的以下代码中的renderUI创建选项卡:

 output$mytabs = renderUI({
   if(is.null(rawData())){return ()}
   channels = unique(rawData()$Channel)
   myTabs = lapply(channels, tabPanel)
   do.call(tabsetPanel, myTabs)
 })

  output$scatterPlot <- renderUI({
    if(is.null(rawData())){return()}
    createPlots()
    myData = rawData()
    channels = unique(myData$Channel)  
    plot_output_list <- lapply(seq_along(channels), function(i) {
      plotname <- paste("plot", i, sep="")
      plotOutput(plotname)
    })

    do.call(tagList, plot_output_list)
  })

  createPlots <- reactive ({ 
    myData = rawData()
    channels = unique(myData$Channel) 
    for (i in seq_along(channels)) {
      local({
        my_i <- i
        plotname <- paste("plot", my_i, sep="")
        tempRows = which(myData$Channel==channels[i]) 
        output[[plotname]] <- renderPlot({
          plot(x = myData$Spend[tempRows], y = myData$Return[tempRows])
        })
      })
    }
  })

然后在ui文件中引用它们如下:

  mainPanel(
    tabsetPanel(
      tabPanel("Data Summary", uiOutput("dataSummary")),
      tabPanel("Parameters & Model Fit", 
               uiOutput('mytabs'),
               uiOutput('scatterPlot')),
      tabPanel("Budget & Spend Summary"),
      tabPanel("Testing", plotOutput('plot5'))
    )
  )

最后,我想在相应的营销渠道标签上为每个营销渠道绘制页面浏览量与访问量。目前,所有四个图都显示在每个营销渠道标签中。在我的全局文件中,我创建了两个函数 - 一个函数一次绘制一个通道,另一个函数绘制所有通道,并将每个通道保存为列表中的单独元素。我不确定其中哪一个最终会有用,如果有的话。

我确定我不理解如何设置'myTabs'或者我从ui中错误地引用它。即使有这段代码,这里的某人也许能够快速发现错误并推荐修复,但我很乐意提供其余的代码,如果这样做会有所帮助。

谢谢! 杰斯

编辑:作为参考,这是我的所有代码。刚刚将dir对象更改为您要使用的目录。

library(shiny)
dir = ""
setwd(dir)

#######################
###  Generate Data  ###
#######################

channels = c("Affiliate","Email","Media","SEO")
nObs = c(round(runif(1,100,200)))
pageViews = runif(nObs*length(channels),50,500)
visits = runif(nObs*length(channels),10,100)

campaignNames = unlist(lapply(channels, FUN = function(x) paste(x,seq(from=1,to=nObs,by=1),sep="")))
channelNames = rep(channels,nObs)

myData = data.frame(Campaign = campaignNames, Channel = channelNames, Return = pageViews, Spend = visits)
write.table(myData,file="myTestData.csv",sep=",",col.names=TRUE,row.names=FALSE)


########################
###  Global Functions  #
########################

summarizeData = function(myDat){
  summaryData = summarize(group_by(myDat,Channel), 'Campaign Count' = length(Campaign), Return = sum(Return), Spend = sum(Spend))
  return(summaryData)
}


###  PLOT DATA AND MODEL FIT  ###
plotSingle = function(myData, channelName){
  p1 <- ggplot(myData[which(myData$Channel==channelName),], aes(x = Spend, y = Return)) +
    geom_point(color="black") +
    theme(panel.background = element_rect(fill = 'grey85'),
          panel.grid.major = element_line(colour = "white"))
  return(p1)
}

plotAll = function(myData){
  channels = unique(myData$Channel)
  plots <- list()  # new empty list
  for (i in 1:length(channels)) {
    channelName = channels[i]
    p1 = plotSingle(myData = myData, channelName = channelName)
    plots[[i]] = p1 
  }
  return(plots)
}


############
###  UI  ###
############

ui <- fluidPage(
  headerPanel('Plot Testing'),
  sidebarPanel(
    h3(helpText("Data Input")),
    fileInput(inputId = "rawDataInput", label = "Upload Data"),
    h5(helpText("Select the file parameters below")),
    checkboxInput(inputId = 'header', label = 'Header', value = TRUE),
    checkboxInput(inputId = "stringAsFactors", "stringAsFactors", FALSE),
    br(),
    radioButtons(inputId = 'sep', label = 'Separator', choices = c(Comma=',',Semicolon=';',Tab='\t', Space=''), selected = ',')

  ),
  mainPanel(
    tabsetPanel(
      tabPanel("Data Summary", uiOutput("dataSummary")),
      tabPanel("Parameters & Model Fit", 
               uiOutput('mytabs'),
               uiOutput('scatterPlot')),
      tabPanel("Budget & Spend Summary"),
      tabPanel("Testing", plotOutput('plot5'))
    )
  )
)

################
###  Server  ###
################

server = function(input, output) {

  rawData <- reactive({
    file1 <- input$rawDataInput
    if(is.null(file1)){return()} 
    read.table(file=file1$datapath, sep=input$sep, header = input$header, stringsAsFactors = input$stringAsFactors)

  })


  # this reactive output contains the summary of the dataset and display the summary in table format
  output$filedf <- renderTable({
    if(is.null(rawData())){return ()}
    input$rawDataInput
  })

  # this reactive output contains the summary of the dataset and display the summary in table format
  output$sum <- renderTable({
    if(is.null(rawData())){return ()}
    summarizeData(rawData())
  })


  # This reactive output contains the dataset and display the dataset in table format
  output$table <- renderTable({
    if(is.null(rawData())){return ()}
    rawData()
  })

  dataPlots = reactive({
    channels = unique(rawData()$Channel)
    plots = plotAll(rawData())
  })

  output$mytabs = renderUI({
    if(is.null(rawData())){return ()}
    channels = unique(rawData()$Channel)
    createPlots()
    plot_output_list <- lapply(seq_along(channels), function(i) {
      plotname <- paste("plot", i, sep="")
      plotOutput(plotname)
    })
    myTabs = lapply(channels, tabPanel)
    do.call(tabsetPanel, myTabs)
  })

  createPlots <- reactive ({ 
    myData = rawData()
    channels = unique(myData$Channel) 
    for (i in seq_along(channels)) {
      local({
        my_i <- i
        plotname <- paste("plot", my_i, sep="")
        tempRows = which(myData$Channel==channels[i]) 
        output[[plotname]] <- renderPlot({
          plot(x = myData$Spend[tempRows], y = myData$Return[tempRows])
        })
      })
    }
  })

  output$scatterPlot <- renderUI({
    if(is.null(rawData())){return()}
    createPlots()
    myData = rawData()
    channels = unique(myData$Channel)  
    plot_output_list <- lapply(seq_along(channels), function(i) {
      plotname <- paste("plot", i, sep="")
      plotOutput(plotname)
    })

    do.call(tagList, plot_output_list)
  })

  output$dataSummary <- renderUI({
    if(is.null(rawData())){return()}
    else
      tabsetPanel(tabPanel("About file", tableOutput("filedf")),tabPanel("Data", tableOutput("table")),tabPanel("Summary", tableOutput("sum")))
  })

  output$plot5 = renderPlot({
    if(is.null(rawData())){return ()}
    myData = rawData()
    channelName = "Affiliate"
    p1 <- ggplot(myData[which(myData$Channel==channelName),], aes(x = Spend, y = Return)) +
      geom_point(color="black") +
      theme(panel.background = element_rect(fill = 'grey85'),
            panel.grid.major = element_line(colour = "white"))
    return(p1)
  })

}


###  Run App ###
shinyApp(ui = ui, server = server)

1 个答案:

答案 0 :(得分:0)

你的例子并不是最小的,所以我做了一些剥离。首先是数据和辅助函数

library(shiny)
library(ggplot2)

channels = c("Affiliate","Email","Media","SEO")
nObs = c(round(runif(1,100,200)))

myData = data.frame(
    Campaign = unlist(lapply(channels, FUN = function(x) paste(x,seq(from=1,to=nObs,by=1),sep=""))), 
    Channel = rep(channels,nObs), 
    Return = runif(nObs*length(channels),50,500), 
    Spend = runif(nObs*length(channels),10,100)
)

plotSingle = function(myData, channelName){
  ggplot(myData[which(myData$Channel==channelName),], aes(x = Spend, y = Return)) +
    geom_point(color="black") +
    theme(panel.background = element_rect(fill = 'grey85'),
          panel.grid.major = element_line(colour = "white"))
}

现在是用户界面

ui <- fluidPage(
  headerPanel('Plot Testing'),
  mainPanel(    
    uiOutput('mytabs'),
    plotOutput('scatterPlot')
  )
)

请注意,我们这里只使用一个plotOutput。我们要做的就是根据当前选择的标签更改它显示的情节。这是服务器代码

server = function(input, output) {

  rawData <- reactive({
    myData
  })

  output$mytabs = renderUI({
    if(is.null(rawData())){return ()}
    channels = unique(rawData()$Channel)
    myTabs = unname(Map(tabPanel, channels))
    do.call(tabsetPanel, c(myTabs, id="channeltab"))
  })

  output$scatterPlot <- renderPlot({
    if(is.null(rawData()) | is.null(input$channeltab)){return ()}
    plotSingle(rawData(), input$channeltab)
  })

}

您看到我们在我们创建的id上设置了tabsetPanel。然后我们可以将其用作input来确定选择哪个面板并显示正确的图。全部用

运行
shinyApp(ui = ui, server = server)