reactive input using flexdashboard

Posit Professional & Hosted Products shinyapps.io
, , ,
1

Hello,
I am using flexdashboard with shiny. I want to take some input text in a selectInput column, and then create a reactive expression that dynamically updates the output (a website) given such input. The goal would be to display the output across different columns (using the same input in the first column). I believe my problem is the way I am setting up the input and output logic, or perhaps something related to scoping.

I have been able to get it to work just in shiny, without flexdashboard:

library(shiny)

ui <- fluidPage(titlePanel("Testing"), 
                sidebarLayout(
                    sidebarPanel(
                        fluidRow(
                            column(9, selectInput("Color", label=h5("Choose a color"),choices=c('red', 'blue'))
                            ))),
                    mainPanel(fluidRow(
                        htmlOutput("frame")
                    )
                    )
                ))

server <- function(input, output) {
    observe({ 
        query <- input$Color
        test <<- paste0("https://en.wikipedia.org/wiki/",query)
    })
    output$frame <- renderUI({
        input$Color
        my_test <- tags$iframe(src=test, height=600, width=535, frameborder = "no")
        print(my_test)
        my_test
    })
}

shinyApp(ui, server)

But when I use flexdashboard it does not work. Here is my failed attempt:

---
title: "Testing Colors"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
    runtime: shiny
---

```{r setup, include=FALSE}
library(flexdashboard)
library(knitr)

lookup <- structure(c("r", "b"), .Names = c("Red", "Blue"))

Column {.sidebar}
-----------------------------------------------------------------------

```{r}
selectInput('Color', label = 'Select a color', choices = lookup, selected = "r")


Column {data-width=600}
-----------------------------------------------------------------------

### Color Web Page

```{r}
observeEvent(input$Color,{
    output$url <-renderUI(a(href=paste0("https://en.wikipedia.org/wiki/", input$Color)))
  })


Column {data-width=400}
-----------------------------------------------------------------------

### Another webpage

```{r}
selectedColor<- reactive({ 
  color <- input$Color 
  }) 
webpage <- renderUI({ 
  include_url(paste0("https://www.wikipedia.org/",selectedColor))
  })
webpage

I would appreciate any suggestions. Thanks!

2 Likes