Встроить веб-сайт в блестящее приложение с помощью flexdashboard: не работает, не реагирует - PullRequest
Новая
       94

Встроить веб-сайт в блестящее приложение с помощью flexdashboard: не работает, не реагирует

0 голосов
/ 28 мая 2020

Я пытаюсь сделать shinyapp с помощью flexdashboard. Приложение принимает в качестве входных данных строку текста, а затем выводит веб-сайт, используя этот входной текст. У меня есть пример работы приложения в стандартном сиянии. Моя проблема в том, чтобы «перевести» его в приложение с помощью 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)

Вот моя попытка заставить его работать с помощью flexdashboards. У меня возникла проблема с попыткой получить входные данные в виде реактивного выражения, чтобы сделать мой вывод динамическим c. Я пытаюсь получить результат двумя разными способами, но ни один из них не работает. 

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

Буду признателен за любые комментарии или идеи.

Спасибо!

1 Ответ

0 голосов
/ 09 июня 2020

Этот код вернул мне flexdashboard с selectInput, я думаю, выравнивание пробелов сделано для ошибок 

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


```

```{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
...