Reputation: 307
I am trying to create this shiny App with navigation panel. The first tab on navBar will be a summary table, in which I want to make the first column content clickable and navigate to its detail tab content. I already make the text as hyperlink, but I wonder how do I actually make the onClick navigation work.
_______________________Updating the Question______________________
So I made some updates according to suggestions I got. I just use the function actionLink(), combined with an ObserveEvent({updateNavPanel})
It seems the main question is that actionLink inside a DT table won't work, but outside it works fine. Maybe I just missing some callback functions to let it recognize buttons inside DT?
Below are the codes: Summary1 shows the action link that works, Summary2 shows the action link within DT that dones't work.
---
title: "Fruit Dashboard"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r global, include=FALSE, echo=FALSE}
# import libraries
library(DT)
library(shiny)
library(tidyverse)
library(shinythemes)
library(shinydashboard)
```
```{r, echo = FALSE}
shinyApp(
ui <- fluidPage(
titlePanel("Fruit Dashboard"),
theme = shinytheme("united"),
navlistPanel(id='nav', widths = c(2, 10),
tabPanel('Summary1', actionLink('apple', 'go to apple')),
tabPanel('Summary2', dataTableOutput('summary')),
tabPanel("apple", dataTableOutput('apple')),
tabPanel("orange", dataTableOutput('orange')),
tabPanel("watermelon", dataTableOutput('watermelon'))
)
),
server <- function(input, output, session) {
observeEvent(input$apple, {
updateNavlistPanel(session, "nav", 'apple')
})
output$summary <- renderDataTable({
data <- data.frame('Fruit' = c('apple', 'orange', 'watermelon'),
'Count' = c(3,4,5)) %>%
mutate(Fruit = paste0("<a id='", Fruit, "' hrep='#' class='action-button'>", Fruit, "</a>" ))
table <- datatable(data, escape = FALSE , selection = 'none')
table
})
output$apple <- renderDataTable({
data <- data.frame('Total#' = 3, 'Organic#'= 2, 'Conventional#'=1)
table <- datatable(data, escape = FALSE)
table
})
output$orange <- renderDataTable({
data <- data.frame('Total#' = 4, 'Organic#'= 3, 'Conventional#'=1)
table <- datatable(data, escape = FALSE)
table
})
output$watermelon <- renderDataTable({
data <- data.frame('Total#' = 5, 'Organic#'= 2, 'Conventional#'= 3)
table <- datatable(data, escape = FALSE)
table
})
}
)
```
Upvotes: 5
Views: 2293
Reputation: 307
Get inspired by the answer here: R Shiny: Handle Action Buttons in Data Table
I guess the key is to add the on.click parameter when creating actionLinks inside DT, so that click triggers event. And the on.click can also assign unique button id to the actionLink/button. Then in observeEvent, simply put the expression as input$selected_button. See full code below:
---
title: "Fruit Dashboard"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r global, include=FALSE, echo=FALSE}
# import libraries
library(DT)
library(shiny)
library(tidyverse)
library(shinythemes)
library(shinydashboard)
df <- data.frame('Fruit' = c('apple', 'orange', 'watermelon'),
'Count' = c(3,4,5))
shinyInput <- function(FUN, len, id, label, ...) {
inputs <- character(len)
for (i in seq_len(len)) {
label <- df$Fruit[i]
inputs[i] <- as.character(FUN(paste0(id, i),label=label, ...))
}
inputs
}
```
```{r, echo = FALSE}
shinyApp(
ui <- fluidPage(
titlePanel("Fruit Dashboard"),
theme = shinytheme("united"),
navlistPanel(id='nav', widths = c(2, 10),
tabPanel('Summary2', dataTableOutput('summary')),
tabPanel("apple", dataTableOutput('apple')),
tabPanel("orange", dataTableOutput('orange')),
tabPanel("watermelon", dataTableOutput('watermelon'))
)
),
server <- function(input, output, session) {
output$summary <- renderDataTable({
data <- df %>%
mutate(Fruit = shinyInput(actionLink, nrow(df), 'button_', label = Fruit, onclick = 'Shiny.onInputChange(\"select_button\", this.id)' ))
table <- datatable(data, escape = FALSE , selection = 'none')
table
})
observeEvent(input$select_button, {
selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2])
updateNavlistPanel(session, 'nav', df[selectedRow, 1])
})
output$apple <- renderDataTable({
data <- data.frame('Total#' = 3, 'Organic#'= 2, 'Conventional#'=1)
table <- datatable(data, escape = FALSE)
table
})
output$orange <- renderDataTable({
data <- data.frame('Total#' = 4, 'Organic#'= 3, 'Conventional#'=1)
table <- datatable(data, escape = FALSE)
table
})
output$watermelon <- renderDataTable({
data <- data.frame('Total#' = 5, 'Organic#'= 2, 'Conventional#'= 3)
table <- datatable(data, escape = FALSE)
table
})
}
)
```
Upvotes: 1