Question

我有一个Shiny App，并且希望当用户选择一行以将值显示为geom_line图时。还应该可以比较不同的值。不幸的是，我没有解决这种情况。显示了一个产品，但是我不能比较两个产品。我的想法是根据input$Main_table_rows_selected值生成几个数据帧。有可能吗？

我的代码如下：

library(shiny)
library(shinydashboard)
library(data.table)
library(DT)
library(ggthemes)

shinyServer(function(input, output) {
  output$MainBody<-renderUI({
    fluidPage(
      box(width=12,
      h3(strong("Actions on datatable with buttons"),align="center"),
      hr(),
      column(6,offset = 6,
      HTML('<div class="btn-group" role="group" aria-label="Basic example">'),

      actionButton(inputId = "Compare_row_head",label = "Compare selected rows"),
      HTML('</div>')
    ),

    column(12,dataTableOutput("Main_table")),
    tags$script(HTML('$(document).on("click", "input", function () {
      var checkboxes = document.getElementsByName("row_selected");
      var checkboxesChecked = [];
      for (var i=0; i<checkboxes.length; i++) {
        if (checkboxes[i].checked) {
          checkboxesChecked.push(checkboxes[i].value);
        }
      }
      Shiny.onInputChange("checked_rows",checkboxesChecked);
    })')),

    tags$script("$(document).on('click', '#Main_table button', function () {
      Shiny.onInputChange('lastCdata4lickId',this.id);
      Shiny.onInputChange('lastClick', Math.random())
    });")
  })
})

article <- c('1001', '1002', '1003', '1001', '1002', '1003')
title <- c('A', 'B', 'C', 'A', 'B', 'C')
date <- as.Date(c('2018-11-14', '2018-11-14', '2018-11-14', '2018-11-21', '2018-11-21', '2018-11-21'))
price <- as.numeric(c('12.50', '15.00', '18.00', '10.50', '13.50', '18.00'))
url <- c('http://www.example.com/ProductA', 'http://www.example.com/ProductB', 'http://www.example.com/ProductC', 'http://www.example.com/ProductA', 'http://www.example.com/ProductB', 'http://www.example.com/ProductC')

data1 <- data.frame(article, title, date, price, url)
data3 = data1[, c('article', 'title', 'price', 'date')]

output$Main_table<-renderDataTable({
  DT=data3
  DT[["Select"]]<-paste0('<input type="checkbox" name="row_selected" value="Row',1:nrow(data3),'"><br>')
  DT[["Actions"]]<-
    paste0('
      <div class="btn-group" role="group" aria-label="Basic example></div>
    ')
    datatable(DT,
      escape=F)}
    )

  observeEvent(input$Compare_row_head,{
    row_to_del=as.numeric(gsub("Row","",input$checked_rows))
    number_brands=length(row_to_del)
    showModal(fake_sales_modal)
  })

  fake_sales_modal<-modalDialog(
    fluidPage(
      h3(strong("Output Plot"),align="center"),
      plotOutput('sales_plot')
    ),
    size="l"
  )

  output$sales_plot<-renderPlot({
    require(ggplot2)
    data4 <- subset(data3, data3$article == data3[input$Main_table_rows_selected,1])
    ggplot(data4, aes(data4$date, data4$price, color=data4$article)) + xlab("Date") + ylab("Price") + theme_economist() + ggtitle("Resume") + geom_line(size = 1) + scale_colour_tableau(name = "Number:" ) + ylim(0, 20) + geom_point() + theme(text = element_text(size = 10)) + theme(axis.title = element_text(size = 15))
  })
})

编辑：

我用Loop尝试了一下，但只得到了空的DF：

     output$sales_plot<-renderPlot({
    require(ggplot2)

    for (i in data3[input$Main_table_rows_selected, 1]) {
    assign(paste0("y",i), data1[data1$article==data1[input$Main_table_rows_selected, 1][i],])
  } 

    ggplot(y, aes(y$date, y$price, color=y$article)) + xlab("Date") + ylab("Size") + theme_economist() + ggtitle("Number") + geom_line(size = 1) + scale_colour_tableau(name = "Number:" ) + ylim(0, 20) + geom_point() + theme(text = element_text(size = 10)) + theme(axis.title = element_text(size = 15))

  })

Output: y1001:
     article title date price  url
NA      <NA>  <NA> <NA>    NA <NA>
NA.1    <NA>  <NA> <NA>    NA <NA>
NA.2    <NA>  <NA> <NA>    NA <NA>
NA.3    <NA>  <NA> <NA>    NA <NA>
NA.4    <NA>  <NA> <NA>    NA <NA>
NA.5    <NA>  <NA> <NA>    NA <NA>

编辑：

好了，现在我得到了正确的子集：

output$sales_plot<-renderPlot({
    require(ggplot2)

    for (i in data3[input$Main_table_rows_selected, 1]) {

    data4 <- subset(data3, data3$article %in% data3[input$Main_table_rows_selected, 1])  
      #assign(paste0("y",i), data3[data3$article==data3[input$Main_table_rows_selected, 1][i],])


      }
    ggplot(data4, aes(data4$date, data4$price, color=data4$article)) + xlab("Date") + ylab("Size") + theme_economist() + ggtitle("Number") + geom_line(size = 1) + scale_colour_tableau(name = "Number:" ) + ylim(0, 20) + geom_point() + theme(text = element_text(size = 10)) + theme(axis.title = element_text(size = 15))

})

但是绘图输出返回：警告：错误：提供给离散刻度的连续值

Answer 1

确定。当我使用as.factor（）更新颜色时，它可以工作。

循环数据框，用于绘图输出

1 个答案: