сюжетно HTML встроен в блестящий - PullRequest
Новая
       15

сюжетно HTML встроен в блестящий

0 голосов
/ 06 марта 2019

Я сгенерировал несколько графиков, используя plotly, и сохранил их как офлайн html (я не хочу генерировать их вживую, так как генерация их в фоновом режиме займет много времени).Ниже приведены два графика, взятые с сайта plotly, и я сохранил их как HTML. 

#Graph 1
Animals <- c("giraffes", "orangutans", "monkeys")
SF_Zoo <- c(20, 14, 23)
LA_Zoo <- c(12, 18, 29)
data <- data.frame(Animals, SF_Zoo, LA_Zoo)

p <- plot_ly(data, x = ~Animals, y = ~SF_Zoo, type = 'bar', name = 'SF Zoo') %>%
  add_trace(y = ~LA_Zoo, name = 'LA Zoo') %>%
  layout(yaxis = list(title = 'Count'), barmode = 'group')

htmlwidgets::saveWidget(p, file="zoo.html")


#Graph 2
x <- c('Product A', 'Product B', 'Product C')
y <- c(20, 14, 23)
text <- c('27% market share', '24% market share', '19% market share')
data <- data.frame(x, y, text)

p <- plot_ly(data, x = ~x, y = ~y, type = 'bar', text = text,
             marker = list(color = 'rgb(158,202,225)',
                           line = list(color = 'rgb(8,48,107)',
                                       width = 1.5))) %>%
  layout(title = "January 2013 Sales Report",
         xaxis = list(title = ""),
         yaxis = list(title = ""))
htmlwidgets::saveWidget(p, file="product.html")

Я написал несколько кодов shiny, которые могут отображать вывод HTML из Rmarkdown, но не HTML, которыйя сгенерирован из plotly выше.Обратите внимание, что первый выбор (пример) в selectInput() - это то, что я сгенерировал по умолчанию Rmarkdown html, и это работает.Я также сгенерировал несколько rmarkdown html, и я мог также переключаться между htmls в приложении shiny, но не для plotly html. 

ui= fluidPage(
  titlePanel("opening web pages"),
  sidebarPanel(
    selectInput(inputId='test',label=1,choices=c("sample","zoo","product"))
  ),
  mainPanel(
    htmlOutput("inc")
  )
)
server = function(input, output) {
  getPage<-function() {
    return(includeHTML(paste0("file:///C:/Users/home/Documents/",input$test,".html")))
  }
  output$inc<-renderUI({getPage()})
}
shinyApp(ui, server)

1 Ответ

0 голосов
/ 07 марта 2019

Вы можете использовать для этого iframe - также посмотрите на addResourcePath: 

ui = fluidPage(
  titlePanel("opening web pages"),
  sidebarPanel(selectInput(
    inputId = 'test',
    label = 1,
    choices = c("sample", "zoo", "product")
  )),
  mainPanel(htmlOutput("inc"))
)

server = function(input, output) {
  myhtmlfilepath <- getwd() # change to your path
  addResourcePath('myhtmlfiles', myhtmlfilepath)

  getPage <- function() {
    return(tags$iframe(src = paste0("myhtmlfiles/", input$test, ".html"), height = "100%", width = "100%", scrolling = "yes"))
  }

  output$inc <- renderUI({
    req(input$test)
    getPage()
  })
}

shinyApp(ui, server)
...