Plots in DT table

shiny
1

Hi all,

In the below application, the column e has some plots. But when you open the application it does not show. But when you click on any of the column headers, you see the plots in column e. Why is that so? Can we not have by default?

library(shiny)
library(DT)
library(glue)
library(dplyr)

asd1 <- data.frame(a = c(3,4,5,6), b = c("A","B","C","D"))
asd_fun <- function(x){as.vector(asd1$b)}

ui <- fluidPage(
  selectInput("do", "select", choices = sapply(asd1$a, asd_fun)),
  selectInput("do1", "select1", choices = c("a" = 50,"b" = 100)),
  dataTableOutput("graph1")
)

server <- function(input, output, session) {
   
  # a1 <- 3
  
 
  
    output$graph1 <- renderDataTable({
      df_1 <- data.frame(a = c(50,100,150), b= c(860,1600,300), c = c(1140, 1700, 700),
                         d= c(960,1700,400), x = c(1130, 1100, 800),
                         y= c(160,700,300), z = c(130, 100, 300))
      
      df1 <-  df_1 %>% filter(a %in% input$do1) %>% mutate(bc = paste0(b, ",", c), dx = paste0(d, ",", x), yz = paste0(y, ",", z), e =  c(glue::glue(HTML('
<html>
<script src="https://cdnjs.cloudflare.com/ajax/libs/Chart.js/2.5.0/Chart.min.js"></script>
<body>
<canvas id="myChart{a}" style="width:100%;max-width:600px"></canvas>

<script>
var xValues = [1,3];

new Chart("myChart{a}", {{
  type: "line",
  data: {{
    labels: xValues,
    datasets: [{{ 
      data: [{bc}],
      borderColor: "red",
      fill: false
    }}, {{ 
      data: [{dx}],
      borderColor: "green",
      fill: false
    }}, {{ 
      data: [{yz}],
      borderColor: "blue",
      fill: false
    }}]
  }},
  options: {{
    legend: {{display: false}}
  }}
}});
</script>
'))))
      
      datatable(df1, escape = F,rownames = F,selection = 'none', options = list(autowidth = FALSE))
    
  })
}

shinyApp(ui, server)
2

"https://cdnjs.cloudflare.com/ajax/libs/Chart.js/2.5.0/Chart.min.js" is only loaded once you click the table.

Try to move it into the header of the page:

library(shiny)
library(DT)
library(glue)
library(dplyr)

asd1 <- data.frame(a = c(3,4,5,6), b = c("A","B","C","D"))
asd_fun <- function(x){as.vector(asd1$b)}

ui <- fluidPage(
  tags$script(src="https://cdnjs.cloudflare.com/ajax/libs/Chart.js/2.5.0/Chart.min.js"),
  selectInput("do", "select", choices = sapply(asd1$a, asd_fun)),
  selectInput("do1", "select1", choices = c("a" = 50,"b" = 100)),
  dataTableOutput("graph1")
)

server <- function(input, output, session) {
  
  # a1 <- 3
  
  
  
  output$graph1 <- renderDataTable({
    df_1 <- data.frame(a = c(50,100,150), b= c(860,1600,300), c = c(1140, 1700, 700),
                       d= c(960,1700,400), x = c(1130, 1100, 800),
                       y= c(160,700,300), z = c(130, 100, 300))
    
    df1 <-  df_1 %>% filter(a %in% input$do1) %>% mutate(bc = paste0(b, ",", c), dx = paste0(d, ",", x), yz = paste0(y, ",", z), e =  c(glue::glue(HTML('
<canvas id="myChart{a}" style="width:100%;max-width:600px"></canvas>
<script>
var xValues = [1,3];

new Chart("myChart{a}", {{
  type: "line",
  data: {{
    labels: xValues,
    datasets: [{{ 
      data: [{bc}],
      borderColor: "red",
      fill: false
    }}, {{ 
      data: [{dx}],
      borderColor: "green",
      fill: false
    }}, {{ 
      data: [{yz}],
      borderColor: "blue",
      fill: false
    }}]
  }},
  options: {{
    legend: {{display: false}}
  }}
}});
</script>
'))))
    
    datatable(df1, escape = F,rownames = F,selection = 'none', 
              options = 
                list(
                  autowidth = FALSE
                  )
              )
    
  })
}

shinyApp(ui, server)
3

Thanks a lotttttttttt

4

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

If you have a query related to it or one of the replies, start a new topic and refer back with a link.