Create Data Frames in Shiny with Loop for Plot

shiny
, ,
1

I have a Shiny App and want when the user selects a line to display the values as a geom_line plot. It should also be possible to compare different values. Unfortunately I don't get this case solved. A product is displayed but I cannot compare two products. My idea was to generate several data frames based on the input$Main_table_rows_selected values. Is that possible somehow?

My code looks like this:

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))
  })
})

EDIT:

I tried it with a Loop but get only empty DFs:

     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>
2

I'm not exactly sure what you want the plot to look like but I reorganized the code a bit and it seems to be working.

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

data1 <- data.frame(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'))

data3 <- data1[, c('article', 'title', 'price', 'date')]



ui <- 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())
          });")
         )
     )


server <- function(input, output) {

     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({
       print(input$Main_table_rows_selected )
       print(data3[input$Main_table_rows_selected , 1])
    data4 <- subset(data3, data3$article %in% data3[input$Main_table_rows_selected , 1])

    ggplot(data4, aes(date, price, color = article)) +
         geom_point() +
         geom_line(size = 1) +
         labs(x = "Date", y = "Price", title = "Resume") +
         scale_colour_tableau(name = "Number:" ) +
         ylim(0, 20) +
         theme_economist() +
         theme(text = element_text(size = 10), axis.title = element_text(size = 15))
  })
}

shinyApp(ui = ui, server = server)
3

This topic was automatically closed 21 days after the last reply. New replies are no longer allowed.