I have a simple app and want to add custom icons to my TabPanels
See code
library(shiny)
ui <- fluidPage(
br(),
navlistPanel(
tabPanel('Menu1', icon = icon("bar-chart-o"),
'Menu One',
tags$img(src='svg/frame.svg', height='40', width='40')
),
tabPanel('Menu2',
icon = tags$img(src='svg/frame.svg', height='40', width='40'),
'Menu Two')
)
)
server <- function(input, output) {
}
# Run the application
shinyApp(ui = ui, server = server)
As you can see, the tag is working well and I can see the svg image (in www/svg)
However it does not render the icon for Menu 2.
Quick solution is
title = div(img(src="svg/frame.svg"), "My Title")
library(shiny)
ui <- fluidPage(
br(),
navlistPanel(
tabPanel('Menu1', icon = icon("bar-chart-o"),
'Menu One',
tags$img(src='https://www.svgrepo.com/show/5840/like.svg', height='40', width='40')
),
tabPanel(div(img(src='https://www.svgrepo.com/show/5840/like.svg', height='20', width='20'), "Menu2"),
'Menu Two')
)
)
server <- function(input, output) {
}
# Run the application
shinyApp(ui = ui, server = server)
Related
In order to make an app where panels are created dynamically, I would like to remove, hide and/or update panels from the package shinyWidgets.
I didn't find any function to do so nor way to add IDs to these panel.
If you have the solution or a way around, I would be more than happy. Thank you in advance !
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
panel(
heading = "Test panel",
actionButton("remove_panel", "Remove this panel")
)
)
server <- function(input, output) {
observeEvent(input$remove_panel,{
print("remove panel")
})
}
shinyApp(ui = ui, server = server)
There is no official method you can use to change the panel states, but we can do it with custom expressions.
library(shiny)
library(shinyWidgets)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
panel(
heading = "Test panel1",
id = "test_panel1",
actionButton("remove_panel", "Remove this panel")
),
panel(
heading = "Test panel2",
id = "test_panel2",
"some content"
),
actionButton("hide_panel", "Hide this panel")
)
server <- function(input, output) {
observeEvent(input$remove_panel,{
removeUI('.panel:has([id="test_panel1"])', immediate = TRUE)
})
observeEvent(input$hide_panel,{
toggle(selector = '.panel:has([id="test_panel2"])')
if(input$hide_panel %% 2 == 1) return(updateActionButton(inputId = "hide_panel", label = "Show this panel"))
updateActionButton(inputId = "hide_panel", label = "Hide this panel")
})
}
shinyApp(ui = ui, server = server)
To remove:
add an ID argument to your panel, and use removeUI to remove it. Remember to change the ID in you own case.
To hide/show:
We can use toggle from shinyjs to show or hide some elements we choose.
Use updateActionButton to also change it text when hidden.
I want to change the style of my Shiny app. I went here https://bootswatch.com/solar/ and downloaded the style .css file: "Solar A spin on Solarized".
library(shiny)
ui <- fluidPage(
titlePanel(tags$i(h1(strong("My Panel Title"),style = "font-family: 'times'; font-size: 82px"))),align="center",
navbarPage(theme="bootstrap.min.css",title = 'Methods',
tabPanel('One'),
tabPanel('Two'),
tabPanel('Three'),
tabPanel('Four'))
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
But as you can see the navigation bar looks weird:
How can I fix it?
The theme that you link to is a Bootstrap 4 theme, but Shiny uses Bootstrap 3. For compatible Bootswatch themes, see their v3 collection: https://bootswatch.com/3/.
For example, using the v3 Flatly theme via a CDN:
library(shiny)
ui <- fluidPage(
titlePanel(tags$i(
h1(strong("My Panel Title"), style = "font-family: 'times'; font-size: 82px")
)),
align = "center",
navbarPage(
theme = "https://stackpath.bootstrapcdn.com/bootswatch/3.4.1/flatly/bootstrap.min.css",
title = 'Methods',
tabPanel('One'),
tabPanel('Two'),
tabPanel('Three'),
tabPanel('Four')
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
I read all the threads about dynamic ui within the Shiny framework, but I did not find anything that work. I want to display a twitter timeline. This chunk of code works really well :
library(shiny)
library(shinydashboard)
runApp(list(ui = fluidPage(
tags$head(tags$script('!function(d,s,id){var js,fjs=d.getElementsByTagName(s) [0],p=/^http:/.test(d.location)?\'http\':\'https\';if(!d.getElementById(id)){js=d.createElement(s);js.id=id;js.src=p+"://platform.twitter.com/widgets.js";fjs.parentNode.insertBefore(js,fjs);}}(document,"script","twitter-wjs");')),
titlePanel(""),
sidebarLayout(
sidebarPanel()
, mainPanel(
a("Tweets by Andrew Ng",
class="twitter-timeline",
href = "https://twitter.com/AndrewYNg"
)
)
)
)
, server = function(input, output, session){
}
)
)
But when, I try to make it reactive, I only got a link to the twitter timeline:
library(shiny)
library(shinydashboard)
runApp(list(ui = fluidPage(
tags$head(tags$script('!function(d,s,id){var js,fjs=d.getElementsByTagName(s) [0],p=/^http:/.test(d.location)?\'http\':\'https\';if(!d.getElementById(id)){js=d.createElement(s);js.id=id;js.src=p+"://platform.twitter.com/widgets.js";fjs.parentNode.insertBefore(js,fjs);}}(document,"script","twitter-wjs");')),
titlePanel(""),
sidebarLayout(
sidebarPanel()
, mainPanel(
uiOutput("mytimeline")
)
)
)
, server = function(input, output, session){
output$mytimeline <- renderUI({
a("Tweets by Andrew Ng",
class="twitter-timeline",
href = "https://twitter.com/AndrewYNg"
)
})
}
)
)
The Twitter script only loads embedded content when it runs the first time. Since the script is in static UI but the timeline is in dynamic UI, the script will always run before the timeline is inserted.
The Twitter docs have a section about this: https://dev.twitter.com/web/javascript/initialization
You can run twttr.widgets.load() to scan the page for newly added embedded content.
One way to run execute this when inserting embedded content would be to include it in a script tag:
library(shiny)
twitterTimeline <- function(href, ...) {
tagList(
tags$a(class = "twitter-timeline", href = href, ...),
tags$script("twttr.widgets.load()")
)
}
runApp(list(ui = fluidPage(
tags$head(tags$script('!function(d,s,id){var js,fjs=d.getElementsByTagName(s) [0],p=/^http:/.test(d.location)?\'http\':\'https\';if(!d.getElementById(id)){js=d.createElement(s);js.id=id;js.src=p+"://platform.twitter.com/widgets.js";fjs.parentNode.insertBefore(js,fjs);}}(document,"script","twitter-wjs");')),
titlePanel(""),
sidebarLayout(
sidebarPanel()
, mainPanel(
uiOutput("mytimeline")
)
)
)
,
server = function(input, output, session) {
output$mytimeline <- renderUI({
twitterTimeline("https://twitter.com/AndrewYNg", "Tweets by Andrew Ng")
})
}
))
See How to enable syntax highlighting in R Shiny app with htmlOutput for a similar issue with more details
I would like to add a tooltip for navbarMenu in Shiny app. Similar question asked here but, there is no answer.Here is my reproducible code
library(shiny)
library(shinyBS)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(),
mainPanel(tabsetPanel(
navbarMenu("Tab1",bsTooltip(id="Tab1", title="Short description for the tab", trigger = "hover"),
tabPanel("Tab1.1"),
tabPanel("Tab1.2")),
tabPanel("Tab2",tabsetPanel(
tabPanel("Tab2.1"),
tabPanel("Tab2.2"))),
tabPanel("Tab3",tabsetPanel(
tabPanel("Tab3.1"),
tabPanel("Tab3.2"),
tabPanel("Tab3.3")))
)))))
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
During my research I found this solution R Shiny: Use navbarPage with bsModal by shinyBS, but for bsModel.
Also, there is a procedure mentioned here which is based in java-script.I know both solutions are for tabpanel but I believe it's the same problem, which is navbarMenu and tabpanel don't have an id.
I'm statistician and I don't have background in HTML or java-script to rewrite the attribute for the tab title or navbarMenu.
I hope I phrase my question in a clear manner. Thanks in advance for your time and kind help.
you can use HTML wenn passing the Title of the Tabs. in this case I just pt the title in a span and added the attribute titlewhich is the attribute HTML uses default for mouse-overs. For me this is much sinpler the trying to add it over shinyBS.
library(shiny)
library(shinyBS)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(),
mainPanel(tabsetPanel(
navbarMenu(span("Tab1",title="Short description for the tab" ),
tabPanel("Tab1.1"),
tabPanel("Tab1.2")),
tabPanel("Tab2",tabsetPanel(
tabPanel("Tab2.1"),
tabPanel("Tab2.2"))),
tabPanel("Tab3",tabsetPanel(
tabPanel("Tab3.1"),
tabPanel("Tab3.2"),
tabPanel("Tab3.3")))
)))))
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
hope this helps!
I found another solution using javascript. Perhaps it may be more useful.
library(shiny)
shinyApp(
ui = navbarPage(
tags$script(HTML('
$( document ).on("shiny:sessioninitialized", function(event) {
$(\'span[data-toggle="tooltip"]\').tooltip({
html: true
});
});'
)),
navbarMenu(
"Menu"
,tabPanel(span("navbarTitle 1",title="XXX",`data-toggle`="tooltip"),
tabsetPanel(
tabPanel(span("Tab 1", title = "aaa",`data-toggle`="tooltip")),
tabPanel(span("Tab 2",title="bbb",`data-toggle`="tooltip")),
tabPanel(span("Tab 3",title="ccc",`data-toggle`="tooltip"))
)
)
,tabPanel( "navbarTitle 2")
)
),
server = function(input, output) {
}
)
I have an URL which changes with an input on shiny app. I want to open an webpage and display that with in the tab panel of shiny window. Every time I change an input the webpage URL gets updated and I want to show that page in the same tab. As of now the web page opens in a separate window than the shiny window using browseURL function of R.
here is small test example for my case
ui.R
shinyUI(fluidPage(
titlePanel("opening web pages"),
sidebarPanel(
selectInput(inputId='test',label=1,choices=1:5)
),
mainPanel(
htmlOutput("inc")
)
))
server.R
shinyServer(function(input, output) {
getPage<-function() {
return((browseURL('http://www.google.com')))
}
output$inc<-renderUI({
x <- input$test
getPage()
})
})
Dont use browseURL. This explicitly opens the webpage in a new window.
library(shiny)
runApp(list(ui= fluidPage(
titlePanel("opening web pages"),
sidebarPanel(
selectInput(inputId='test',label=1,choices=1:5)
),
mainPanel(
htmlOutput("inc")
)
),
server = function(input, output) {
getPage<-function() {
return((HTML(readLines('http://www.google.com'))))
}
output$inc<-renderUI({
x <- input$test
getPage()
})
})
)
If you want to mirror the page you can use an iframe
library(shiny)
runApp(list(ui= fluidPage(
titlePanel("opening web pages"),
sidebarPanel(
selectInput(inputId='test',label=1,choices=1:5)
),
mainPanel(
htmlOutput("inc")
)
),
server = function(input, output) {
getPage<-function() {
return(tags$iframe(src = "http://www.bbc.co.uk"
, style="width:100%;", frameborder="0"
,id="iframe"
, height = "500px"))
}
output$inc<-renderUI({
x <- input$test
getPage()
})
})
)