nirguk / example_shiny_includeHTML

an example of R Shiny for includeHTML with relative <a> link
0 stars 0 forks source link

shiny embed html file #1

Open englianhu opened 2 years ago

englianhu commented 2 years ago
library('shinydashboard')
dashboardPage(
   ...
   ...
  dashboardBody(
    shinyDashboardThemes(theme = 'blue_gradient'), 
    tabItems(...)
  )

## 1st embed method
tabItem(tabName = 'en', h2('English'), 
              tags$iframe(src = 'https://rpubs.com/englianhu/ryo-en', 
                          height = 800, width = '100%', frameborder = 0)),

## 2nd embed method
tabItem(tabName = 'en', h2('English'), 
             HTML(readLines('www/ryo-en.html'))),

## 3rd embed method
tabItem(tabName = 'en', h2('English'), 
             tags$html(includeHTML('www/ryo-en.html'))),

Screenshot_5

Same errors by trying above 3 methods.

Reference

englianhu commented 2 years ago
require('shiny')
require('shinythemes')
require('shinydashboard')
require('dashboardthemes')
require('shinyWidgets')
require('shinyjs')
if(!require('XML')) devtools::install_github('omegahat/XML')
require('XML')

server <- shinyServer(function(input, output, session) {

  #observeEvent(input$rb, {
  #       newtab <- switch(input$tabs, 
  #                        "en" = "en", 
  #                        "cn" = "cn", 
  #                        "tw" = "tw", 
  #                        "jp" = "jp")
  #       updateTabItems(session, "tabs", newtab)
  #    })

  #output$cv_page <- renderUI({
  #  
  #  page = switch(input$rb, 
  #                en = 'ryo-en.html',
  #                cn = 'ryo-cn.html',
  #                tw = 'ryo-tw.html',
  #                jp = 'ryo-jp.html')
  #  
    #HTML(markdown::markdownToHTML('ryo-en.md'))
    #HTML(rmarkdown::render(knit('ryo-en.Rmd')))
  #  includeHTML(page)
  #})

  #observeEvent(input$rb, {
  #  newtab <- switch(input$tabs,
  #                   "home" = "home",
  #                   "en" = "en", 
  #                   "cn" = "cn",
  #                   "tw" = "tw", 
  #                   "jp" = "jp",
  #                   "author" = "author")
  #  updateTabItems(session, "tabs", newtab)
  #})

  observeEvent(input$rb == 'en', {
    updateTabItems(session, "tabs", selected = "en")
  })

  observeEvent(input$rb == 'cn', {
    updateTabItems(session, "tabs", selected = "cn")
  })

  observeEvent(input$rb == 'tw', {
    updateTabItems(session, "tabs", selected = "tw")
  })

  observeEvent(input$rb == 'jp', {
    updateTabItems(session, "tabs", selected = "jp")
  })

  #output$ryo_en <- renderUI({
  #  #HTML(markdown::markdownToHTML('ryo-en.md'))
  #  #HTML(rmarkdown::render(knit('ryo-en.Rmd')))
  #  includeHTML("ryo-en.html")
  #})

  #output$ryo_cn <- renderUI({
  #  #HTML(markdown::markdownToHTML('ryo-en.md'))
  #  #HTML(rmarkdown::render(knit('ryo-en.Rmd')))
  #  includeHTML("ryo-cn.html")
  #})

  #output$ryo_tw <- renderUI({
  #  #HTML(markdown::markdownToHTML('ryo-en.md'))
  #  #HTML(rmarkdown::render(knit('ryo-en.Rmd')))
  #  includeHTML("ryo-tw.html")
  #})

  #output$ryo_jp <- renderUI({
  #  #HTML(markdown::markdownToHTML('ryo-en.md'))
  #  #HTML(rmarkdown::render(knit('ryo-en.Rmd')))
  #  includeHTML("ryo-jp.html")
  #})
})

#shinyApp(server = server, ui = ui)
require('shiny')
require('shinythemes')
require('shinydashboard')
require('dashboardthemes')
require('shinyWidgets')
require('shinyjs')
require('memoise')
if(!require('XML')) devtools::install_github('omegahat/XML')
require('XML')

### creating custom logo object
my_logo <- shinyDashboardLogoDIY(
  boldText = 'ξηg', 
  mainText = 'Lιαη Ημ', 
  textSize = 16, 
  badgeText = '®γσ', 
  badgeTextColor = 'white', 
  badgeTextSize = 2, 
  badgeBackColor = "#40E0D0", 
  badgeBorderRadius = 3)

alignCenter <- memoise(function(el) {
  htmltools::tagAppendAttributes(el, style="width:500vw;height:100vh;background-color:#fff;display:flex;align-items:center;justify-content:center;")
})

ui <- shinyUI(
  dashboardPage(
  dashboardHeader(title = my_logo),

  dashboardSidebar(
    sidebarMenu(id = "tabs", 
      menuItem("Home", tabName = "menu", 
               icon = icon("home"), startExpanded = TRUE, 
               menuSubItem("Curriculum Vitae", tabName = "home"),
               menuSubItem("English", tabName = "en"), 
               menuSubItem("Simplified Chinese", tabName = "cn"), 
               menuSubItem("Traditional Chinese", tabName = "tw"),
               menuSubItem("Japanese", tabName = "jp")),
      menuItem("Appendices", icon = icon("th"), tabName = "Appendices", 
               menuSubItem("Author", tabName = "author"))
      )),
  dashboardBody(
    shinyDashboardThemes(theme = 'blue_gradient'), 
    tabItems(
      tabItem(tabName = 'home', alignCenter(
        prettyRadioButtons(
          inputId = 'rb', label = '', 
          #choices = c('ENGLISH' = 'en', 'Chinese (Simplified)' = 'cn', 
          #            'Chinese (Traditional)' = 'tw', 'Japanese' = 'jp'), 
          choices = c('🇬🇧 ENGLISH' = 'en', '🇨🇳 简体中文' = 'cn', 
                      '🇹🇼 繁体中文' = 'tw', '🇯🇵 日本語' = 'jp'), 
          shape = 'curve', bigger = TRUE, animation = 'pulse', 
          selected = character(0), status = 'primary', thick = TRUE, 
          icon = icon('registered'))
        )), 
      tabItem(tabName = 'en', h2('English'), 
              #tags$iframe(src = 'https://rpubs.com/englianhu/ryo-en', 
              #            height = 800, width = '100%', frameborder = 0)#, 
              #HTML(readLines('www/ryo-en.html')), 
+              fluidPage(includeHTML('www/ryo-en.html'))), 
      tabItem(tabName = 'cn', h2('Chinese (Simplified)'), 
              #tags$iframe(src = 'https://rpubs.com/englianhu/ryo-cn', 
              #            height = 800, width = '100%', frameborder = 0), 
              #HTML(readLines('www/ryo-cn.html')), 
+              fluidPage(includeHTML('www/ryo-cn.html'))), 
      tabItem(tabName = 'tw', h2('Chinese (Traditional)'), 
              #tags$iframe(src = 'https://rpubs.com/englianhu/ryo-tw', 
              #            height = 800, width = '100%', frameborder = 0), 
              #HTML(readLines('www/ryo-tw.html')), 
+              fluidPage(includeHTML('www/ryo-tw.html'))), 
      tabItem(tabName = 'jp', h2('Japanese'), 
              #tags$iframe(src = 'https://rpubs.com/englianhu/ryo-jp', 
              #            height = 800, width = '100%', frameborder = 0), 
              #HTML(readLines('www/ryo-jp.html')), 
+              fluidPage(includeHTML('www/ryo-jp.html'))), 
      tabItem(tabName = 'author', h2('Author'), 
              #tags$iframe(src = 'https://rpubs.com/englianhu/ryo-eng', 
              #            height = 800, width = '100%', frameborder = 0), 
              #HTML(readLines('www/ryo-jp.html')), 
+              fluidPage(includeHTML('www/ryo-jp.html')))), 
    br(), 
    p('Powered by - Copyright® Intellectual Property Rights of ', 
      tags$a(href='https://www.scibrokes.com', target = '_blank', 
             tags$img(height = '20px', alt = 'scibrokes', #align='right', 
                      src='./www/Scibrokes.png')), 
      HTML("<a href='http://www.scibrokes.com'>Scibrokes®</a>")))))

#shinyApp(server = server, ui = ui)

fluidPage() doesn't helps, error shows as below :

runApp('shinyCV')

Listening on http://127.0.0.1:3923
Warning in file(con, "r") :
  无法打开文件'www/ryo-en.html': No such file or directory
Warning: Error in file: 无法打开链结
  91: file
  90: readLines
  89: includeHTML
Warning in file(con, "r") :
  无法打开文件'www/ryo-en.html': No such file or directory
Warning: Error in file: 无法打开链结
  91: file
  90: readLines
  89: includeHTML
englianhu commented 2 years ago
> getwd()
[1] "/home/englianhu/Documents/GitHub/owner"
> tail(dir())
[1] "ryo-tw.Rmd"        "RyoEng.synctex.gz" "shinyCV"           "skeleton.bib"     
[5] "video"             "www"              
> tail(dir('shinyCV'))
[1] "function"  "music"     "rsconnect" "server.R"  "ui.R"      "www"

Copied files from path /home/englianhu/Documents/GitHub/owner/www to path /home/englianhu/Documents/GitHub/owner/shinyCV/www and the webpage shown... will try to guess the css design :

## shiny folder : shinyCV
## shiny files folder : shinyCV/www
runApp('shinyCV')
Listening on http://127.0.0.1:5463

ShinyCV Resume: New Recording - 3/21/2022, 4:34:28 PM from ®γσ ξηg on Vimeo

Will try to take a look to guess on :-

The sidebar keeps there when I using a link instead of a html file during last knitted shinyCV in year 2018, but link need to take times to load the webpage...

jjweimer commented 2 years ago
## 2nd embed method
tabItem(tabName = 'en', h2('English'), 
             HTML(readLines('www/ryo-en.html'))),

Shiny automatically looks inside the www directory, so by calling the file path "www/ryo-en.html" you are actually searching the directory for www/www/ryo-en.html. I believe changing the file path to what is shown below should work:

## 2nd embed method
tabItem(tabName = 'en', h2('English'), 
             HTML(readLines('ryo-en.html'))),
englianhu commented 2 years ago

https://github.com/dreamRs/shinyWidgets/issues/484#issuecomment-1082310436

# ui.R
HTML(readLines('ryo-en.html'))
includeHTML('www/ryo-en.html')

Tried above doesn't work which faced below issues,


#ui.R
htmlOutput('ryo_en')

# server.R
output$ryo_en <- renderUI(includeHTML('www/ryo-en.html'))

Referred to https://stackoverflow.com/a/66691344/3806250, its work but there has another issues :

require('BBmisc')
lib('shiny')
lib('shinythemes')
lib('shinydashboard')
lib('shinydashboardPlus')
lib('dashboardthemes')
lib('shinyWidgets')
lib('shinyjs')
lib('memoise')
if(!require('XML')) devtools::install_github('omegahat/XML')
lib('XML')

conflict_prefer('dashboardPage', 'shinydashboardPlus')
conflict_prefer('dashboardHeader', 'shinydashboardPlus')
conflict_prefer('dashboardSidebar', 'shinydashboardPlus')
conflict_prefer('dashboardFooter', 'shinydashboardPlus')
conflict_prefer('box', 'shinydashboardPlus')

### creating custom logo object
logo <- shinyDashboardLogoDIY(
  boldText = 'ξηg', 
  mainText = 'Lιαη Ημ', 
  textSize = 16, 
  badgeText = '🐉 ®γσ', 
  badgeTextColor = 'white', 
  badgeTextSize = 2, 
  badgeBackColor = "#40E0D0", 
  badgeBorderRadius = 3)

alignCenter <- memoise(function(el) {
  htmltools::tagAppendAttributes(el, style="width:500vw;height:100vh;background-color:#fff;display:flex;align-items:center;justify-content:center;")
})

ui <- shinyUI(

  #fluidPage(
  ## https://dreamrs.github.io/shinyWidgets/reference/setBackgroundColor.html
  # use a gradient in background
  #  setBackgroundColor(
  #    color = c('#2171B5', '#F7FBFF'),
  #    gradient = 'radial',
  #    direction = c('top', 'left')
  #    ),
  #...)
  #
  dashboardPage(#skin = 'midnight', 
    header = dashboardHeader(title = logo),

    sidebar = dashboardSidebar(
      minified = TRUE, collapsed = FALSE, 
      sidebarMenu(
        id = 'tabs', 
        menuItem('®️Studio ☁️', tabName = 'menu', 
                 ## https://getbootstrap.com/docs/3.4/components/#glyphicons
                 ## https://fontawesome.com/icons 
                 icon = icon('fa-brand fa-linux'), startExpanded = TRUE, 
                 menuSubItem('🏠 Home', tabName = 'home'),
                 menuSubItem('🇬🇧 ENGLISH', tabName = 'en'), 
                 menuSubItem('🇨🇳 简体中文', tabName = 'cn'), 
                 menuSubItem('🇹🇼 繁体中文', tabName = 'tw'),
                 menuSubItem('🇯🇵 日本語', tabName = 'jp'),
                 menuSubItem('🇰🇷 한국어', tabName = 'kr'),
                 menuSubItem('🇩🇪 Deutsch', tabName = 'de'),
                 menuSubItem('🇫🇷 français', tabName = 'fr'),
                 menuSubItem('🇮🇹 Italiano', tabName = 'it'))#, 
        #menuItem('Appendices', icon = icon('th'), tabName = 'append', 
        #         menuSubItem('Author', tabName = 'author'))
      )), 

    body = dashboardBody(
      shinyDashboardThemes(theme = 'blue_gradient'), 

      ## https://stackoverflow.com/questions/52198452/how-to-change-the-background-color-of-the-shiny-dashboard-body
      tags$head(tags$style(HTML('
            /* logo */
            /* .skin-blue .main-header .logo { */
            /* background-color: #f4b943; */
            /* } */

            /* logo when hovered */
            .skin-blue .main-header .logo:hover {
            /* background-color: #146275; */
              color: #FFD64D;
              background: linear-gradient(155deg, #17687C 0%, #146275 100%);
              transition: all 0.45s;
              &:hover{
                background: linear-gradient(155deg, #17687C 20%, #3098B3 80%);
              }
            }

            /* navbar (rest of the header) */
            .skin-blue .main-header .navbar {
            /* background-color: #f4b943; */
              color: #FFD64D;
              background: linear-gradient(155deg, #17687C 0%, #146275 100%);
              transition: all 0.45s;
              &:hover{
                background: linear-gradient(155deg, #17687C 20%, #146275 80%);
              }
            }

            /* main sidebar */
            /* .skin-blue .main-sidebar { */
            /* background-color: #f4b943; */
            /* } */

            /* active selected tab in the sidebarmenu */
            .skin-blue .main-sidebar .sidebar .sidebar-menu .active a{
              background-color: #ff0000;
            }

            /* other links in the sidebarmenu */
            /* .skin-blue .main-sidebar .sidebar .sidebar-menu a{ */
            /* background-color: #00ff00; */
            /* color: #000000; */
            /* } */

            /* other links in the sidebarmenu when hovered */
            .skin-blue .main-sidebar .sidebar .sidebar-menu a:hover{
            /* background-color: #FFD64D; */
            /* color: #FFD64D; */
            }

            /* toggle button when hovered  */
            .skin-blue .main-header .navbar .sidebar-toggle:hover{
            /* background-color: #FFD64D; */
              color: #FFD64D;
              background: linear-gradient(155deg, #002C54 0%, #4CB5F5 100%);
              transition: all 0.45s;
              &:hover{
                background: linear-gradient(155deg, #002C54 20%, #4CB5F5 80%);
                }
            }

            /* body */
            .content-wrapper, .right-side {
              background-color: #7da2d1;
            }
            '))), 

      tabItems(
        tabItem(tabName = 'home', h2('®️Studio ☁️', align = 'center'),
                alignCenter(
                  prettyRadioButtons(
                    inputId = 'rb', label = NULL, 
                    choices = c('🇬🇧 ENGLISH' = 'en', 
                                '🇨🇳 简体中文' = 'cn', 
                                '🇹🇼 繁体中文' = 'tw', 
                                '🇯🇵 日本語' = 'jp', 
                                '🇰🇷 한국어' = 'kr', 
                                '🇩🇪 Deutsch' = 'de', 
                                '🇫🇷 Français' = 'fr', 
                                '🇮🇹 Italiano' = 'it'), 
                    shape = 'curve', animation = 'pulse', 
                    selected = character(0), status = 'primary', 
                    thick = TRUE, width = '100%', bigger = TRUE, 
                    icon = icon('registered'))
                )
        ), 
        tabItem(tabName = 'en', h2('🇬🇧 ENGLISH', align = 'center'), 
                #tags$iframe(src = 'http://rpubs.com/englianhu/ryo-en', 
                #            height = 800, width = '100%', frameborder = 0)#, 
                #HTML(readLines('www/ryo-en.html'))#, 
                #includeHTML('www/ryo-en.html')#,
                htmlOutput('ryo_en')
        ), 
        tabItem(tabName = 'cn', h2('🇨🇳 简体中文', align = 'center'), 
                #tags$iframe(src = 'https://rpubs.com/englianhu/ryo-cn', 
                #            height = 800, width = '100%', frameborder = 0)#, 
                #HTML(readLines('www/ryo-cn.html'))#, 
                #includeHTML('www/ryo-cn.html')#,
                htmlOutput('ryo_cn')
        ), 
        tabItem(tabName = 'tw', h2('🇹🇼 繁体中文', align = 'center'), 
                #tags$iframe(src = 'https://rpubs.com/englianhu/ryo-tw', 
                #            height = 800, width = '100%', frameborder = 0)#, 
                #HTML(readLines('www/ryo-tw.html'))#, 
                #includeHTML('www/ryo-tw.html')#,
                htmlOutput('ryo_tw')
        ), 
        tabItem(tabName = 'jp', h2('🇯🇵 日本語', align = 'center'), 
                #tags$iframe(src = 'https://rpubs.com/englianhu/ryo-jp', 
                #            height = 800, width = '100%', frameborder = 0)#, 
                #HTML(readLines('www/ryo-jp.html'))#, 
                #includeHTML('www/ryo-jp.html')#,
                htmlOutput('ryo_jp')
        ), 
        tabItem(tabName = 'kr', h2('🇰🇷 한국어', align = 'center'), 
                #tags$iframe(src = 'https://rpubs.com/englianhu/ryo-kr', 
                #            height = 800, width = '100%', frameborder = 0)#, 
                #HTML(readLines('www/ryo-kr.html'))#, 
                #includeHTML('www/ryo-kr.html')#,
                htmlOutput('ryo_kr')
        ), 
        tabItem(tabName = 'de', h2('🇩🇪 Deutsch', align = 'center'), 
                #tags$iframe(src = 'https://rpubs.com/englianhu/ryo-de', 
                #            height = 800, width = '100%', frameborder = 0)#, 
                #HTML(readLines('www/ryo-de.html'))#, 
                #includeHTML('www/ryo-de.html')#,
                htmlOutput('ryo_de')
        ), 
        tabItem(tabName = 'fr', h2('🇫🇷 Français', align = 'center'), 
                #tags$iframe(src = 'https://rpubs.com/englianhu/ryo-fr', 
                #            height = 800, width = '100%', frameborder = 0)#, 
                #HTML(readLines('www/ryo-fr.html'))#, 
                #includeHTML('www/ryo-fr.html')#,
                htmlOutput('ryo_fr')
        ), 
        tabItem(tabName = 'it', h2('🇮🇹 Italiano', align = 'center'), 
                #tags$iframe(src = 'https://rpubs.com/englianhu/ryo-it', 
                #            height = 800, width = '100%', frameborder = 0)#, 
                #HTML(readLines('www/ryo-it.html'))#, 
                #includeHTML('www/ryo-it.html')#,
                htmlOutput('ryo_it')
        )
      )
    ), 

    footer = dashboardFooter(
      p('Powered by - Copyright® Intellectual Property Rights of ', 
        tags$a(href='https://www.scibrokes.com', target = '_blank', 
               tags$img(height = '20px', alt = 'scibrokes', #align='right', 
                        src='www/Scibrokes.png')), 
        HTML("<a href='https://www.scibrokes.com'>Sςιβrοκεrs Trαdιηg®</a>"))), 
    title = 'DashboardPage'))

server <- shinyServer(function(input, output, session) {
  ## https://stackoverflow.com/questions/56064805/displaying-html-file-using-includehtml-in-shiny-is-not-working-with-renderui
  output$ryo_en <- renderUI(includeHTML('www/ryo-en.html'))
  output$ryo_cn <- renderUI(includeHTML('www/ryo-cn.html'))
  output$ryo_tw <- renderUI(includeHTML('www/ryo-tw.html'))
  output$ryo_jp <- renderUI(includeHTML('www/ryo-jp.html'))
  #output$ryo_kr <- renderUI(includeHTML('www/ryo-kr.html'))
  #output$ryo_de <- renderUI(includeHTML('www/ryo-de.html'))
  #output$ryo_fr <- renderUI(includeHTML('www/ryo-fr.html'))
  #output$ryo_it <- renderUI(includeHTML('www/ryo-it.html'))
})

shinyApp(ui, server)