I am building a R Shiny App with the package fullPage ; I would like to have in the header (=appearing on all pages) a pickerInput that allows the user to select the language.
Could anyone help to achieve this ?
What I was able to do, is only to have this element on the 1st page, but I would like to have it on all pages, ideally in the header, at the same level as the ''menu'' (next to ''First'' and ''Second'' in the minimal example here below).
library(shiny)
library(fullPage)
ui <- fullPage(
menu=c("First"="first",
"Second" ="second"),
fullSection(
menu = "first",
center = TRUE,
pickerInput(
inputId = "lang_select",
label = "Language",
choices = c("ENG", "FR"),
options = list(
style = "btn-primary")
),
h1("Callbacks")
),
fullSection(
menu = "second",
center = TRUE,
h3("Slice"),
verbatimTextOutput("slide")
)
)
server <- function(input, output){
}
shinyApp(ui, server)
Related
I am using the fullPage package to create a Shiny App and I am facing the following issue : I would like to update from the server side the labels of the menu that are first defined in the pagePiling function of the ui part.
I have seen in the HTML code that the field that I should update is the one here below, but I don't know how to change it/access it in the server part of my app.
<ul id="tocMenu">
<li data-menuanchor="test_page">
temp_title
</li>
</ul>
I have the impression that this sould be achievable with javascript, but I don't know a lot about js ; among others, I have tried so far the following stuff :
library(fullPage)
library(shiny)
library(shinyjs)
library(shinyWidgets)
shinyApp(
ui = pagePiling(
shinyjs::useShinyjs(),
center = TRUE,
sections.color = c(
"#CFE2F3"
),
menu = c(
"temp_title" = "test_page"
),
pageSection(
menu="test_page",
pickerInput("title", multiple = F, selected=NULL,
choices = c("Title 1", "Title 2")),
)
),
server = function(input, output) {
observeEvent(input$title, {
# runjs("$('#fullpage').fullpage({
# anchors: ['test'],
# menu: '#tocMenu'});")
runjs(paste0('document.getElementById("test_page").innerHTML = "', input$title, '";'))
} )
}
)
If anyone could help, I would be very grateful !
Thanks
The problem is that you use getElementById() but the menu title doesn't have an id, it has an href tag:
Therefore, you should use querySelectorAll() instead and specify the characteristics of the element you want to select (here, it's an element a that has href="#test_page"). Finally, this function returns a list of elements (this list only contains 1 element here), so you need to use [0] to select it.
Here's your example fixed:
library(fullPage)
library(shiny)
library(shinyjs)
library(shinyWidgets)
shinyApp(
ui = pagePiling(
shinyjs::useShinyjs(),
center = TRUE,
sections.color = c(
"#CFE2F3"
),
menu = c(
"temp_title" = "test_page"
),
pageSection(
menu="test_page",
pickerInput("title", multiple = F, selected=NULL,
choices = c("Title 1", "Title 2")),
)
),
server = function(input, output) {
observeEvent(input$title, {
# runjs("$('#fullpage').fullpage({
# anchors: ['test'],
# menu: '#tocMenu'});")
runjs(paste0('document.querySelectorAll("a[href=\'#test_page\']")[0].innerHTML = "', input$title, '";'))
} )
}
)
I have a collapsible navbar menu in R Shiny. When the menu has collapsed and I click on the Hamburger button, the options appear. When I click on one of the options, another panel is (rightly) chosen, but the menu stays open.
Is it possible to make it so (with css?) that the 'dropdown menu' (i.e. list of options) closes as soon as I have chosen one of the options?
The code looks like this:
library(shiny)
ui <- tagList(
navbarPage(
title = NULL, id = "navBar", collapsible = TRUE,
tabPanel(title = "Panel1", uiOutput('panel1')),
tabPanel(title = "Panel2", uiOutput('panel2')),
tabPanel(title = "Panel3", uiOutput('panel3'))
)
)
server <- function(input, output, session) {
output$panel1 <- renderUI({p("This is panel 1")})
output$panel2 <- renderUI({p("This is panel 2")})
output$panel3 <- renderUI({p("This is panel 3")})
}
shinyApp(ui = ui, server = server)
You could listen on the navbarPage with input$navBar (your id in navbarPage()) and trigger the changes via javascript.
observeEvent(input$navBar, {
runjs('
var elem = document.getElementsByClassName("navbar-collapse")[0]
elem.setAttribute("aria-expanded", "false");
elem.setAttribute("class", "navbar-collapse collapse");
')
})
Reproducible example:
library(shiny)
library(shinyjs)
ui <- tagList(
useShinyjs(),
navbarPage(
title=NULL, id = "navBar", collapsible = TRUE,
tabPanel(title = "Panel1", uiOutput('panel1')),
tabPanel(title = "Panel2", uiOutput('panel2')),
tabPanel(title = "Panel3", uiOutput('panel3'))
)
)
server <- function(input, output, session) {
output$panel1 <- renderUI({p("This is panel 1")})
output$panel2 <- renderUI({p("This is panel 2")})
output$panel3 <- renderUI({p("This is panel 3")})
observeEvent(input$navBar, {
runjs('
var elem = document.getElementsByClassName("navbar-collapse")[0]
elem.setAttribute("aria-expanded", "false");
elem.setAttribute("class", "navbar-collapse collapse");
')
})
}
shinyApp(ui = ui, server = server)
The idea
I have a box() in a shiny app. The box() includes a title argument (which in turn includes an icon) and a selectInput()element. On hoover over the icon I wanted to have a tooltip (using tipify()) or a popover (using popify()) which title or content argument (or both) would be generated depending on selectInput() input.
The problem
Neither tipify() nor popify() correcctly implement textOutput() as their title or content argument. They need a character string so I tried to use a reactiveValues() element as a function argument but it also failed.
The question
Can tooltip or popover content be made dynamic by just using r? How could this be done?
I suspect it can be done with JavaScript but I have little knowledge of it.
The code
Attempt 1 - failed - displays code not actual text
library("shiny")
library("shinydashboard")
library("shinyBS")
ui <- fluidPage(
box(
title = span("My box",
tipify(el = icon(name = "info-circle", lib = "font-awesome"), title = textOutput("TIP"))),
selectInput(
inputId = "SELECT",
label = NULL,
choices = c("Option1" = "Option1",
"Option2" = "Option2"
),
multiple = FALSE
)
)
)
server <- function(input, output, session){
output$TIP <- renderText({"Helo world!"})
}
shinyApp(ui, server)
Attempt 2 - failed - cannot create UI as TIP (reactiveValues()) is not yet defined
library("shiny")
library("shinydashboard")
library("shinyBS")
ui <- fluidPage(
box(
title = span("My box",
tipify(el = icon(name = "info-circle", lib = "font-awesome"), title = TIP$a)),
selectInput(
inputId = "SELECT",
label = NULL,
choices = c("Option1" = "Option1",
"Option2" = "Option2"
),
multiple = FALSE
)
)
)
server <- function(input, output, session){
TIP <- reactiveValues(a = "Hello world!")
}
shinyApp(ui, server)
Here is a similar question but it does not solve the problem described here.
What could be done is creating the title entirely in the server side. This way you have no problem making it dynamic. This could give you this kind of app:
library("shiny")
library("shinydashboard")
library("shinyBS")
ui <- fluidPage(
box(
title = uiOutput("title"),
selectInput(
inputId = "SELECT",
label = NULL,
choices = c("Option1" = "Option1",
"Option2" = "Option2"
),
multiple = FALSE
)
)
)
server <- function(input, output, session){
TIP <- reactiveValues()
observe({
TIP$a <- ifelse(input$SELECT =="Option1","Hello World","Hello Mars")
})
output$title <- renderUI({span("My box",
tipify(el = icon(name = "info-circle", lib = "font-awesome"), title = TIP$a))})
}
shinyApp(ui, server)
Hope it helps.
Is there any way to click an element in a dataTableOutput and then jump to a different tabPanel?
I know using escape = FALSE could add url to the table element. But how to add "jumping to a different tab" to a dataTableOutput element? And passing values?
Please take a look at my reproducible example. Thanks.
library(shiny)
server <- function(input, output) {
X = data.frame(
ID = c(
"<a href = 'http://www.google.com'> google </a>",
"Click here then Jump to tab2 and pass x=2 and y=2 to tab2",
"Click here then Jump to tab2 and pass x=3 and y=4 to tab2"
),
x = c(1, 2, 3),
y = c(10, 2, 4)
)
output$datatable = renderDataTable({X}, escape = FALSE,
options = list(
paging = FALSE,
searching = FALSE,
filtering = FALSE,
ordering = FALSE
))
output$text = renderText(paste("X = ", "Y = "))
}
ui <- fluidPage(tabsetPanel(
tabPanel("tab1", dataTableOutput("datatable")),
tabPanel("tab2", textOutput("text"))
))
shinyApp(ui = ui, server = server)
Luckily, there is no need for JS, or jQuery, since all those things can be done on Shinyserver side.
Okay, where do we start... DT has an inbuild callback feature to acess which rows/columns/cells were clicked by the user. See example here. Then there is no reason to "send" this information to tab2, but we can just do with this information what we wanted to. Like setting the text in tab2 appropriately. In order to change tabs, shiny has the updateTabsetPanel function that lets you change tabs without any hyperlinks.
Kind of a changelog:
insertet the observeEvent for functionality.
added selected and server attribute to get a single row callback
added Id to tabsetPanel to enable communication.
got rid of the google link and escape.
Code:
library(shiny)
library(DT)
server <- function(input, output, session) {
X = data.frame(
ID = c("Click here then Jump to tab2 and pass x=1 and y=10 to tab2",
"Click here then Jump to tab2 and pass x=2 and y=2 to tab2",
"Click here then Jump to tab2 and pass x=3 and y=4 to tab2"),
x = c(1,2,3),
y = c(10,2,4)
)
output$datatable = renderDataTable({X}, selection = "single", server = FALSE,
options = list(paging=FALSE,
searching=FALSE,
filtering=FALSE,
ordering=FALSE)
)
observeEvent(input$datatable_rows_selected, {
row <- input$datatable_rows_selected
output$text <- renderText({paste("X =", X[row, "x"], "Y =", X[row, "y"])})
updateTabsetPanel(session, "mainPanel", selected = "tab2")
})
}
ui <- fluidPage(
tabsetPanel(id = "mainPanel",
tabPanel("tab1",dataTableOutput("datatable")),
tabPanel("tab2",textOutput("text"))
)
)
shinyApp(ui = ui, server = server)
I'm trying to manually expand a submenu in a sidebar in shiny dashboard. The updateTabItems function only works with normal menus, but not with nested menus.
Here is basic example (modified from the updateTabItems documentation) to show the problem. If I clicked on 'Switch tab', it switches the menus, but it doesn't expand the first menu that has a submenu. It seems that it only selected the submenu but doesn't expand the tree.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Simple tabs"),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"),
menuSubItem("Sub Menu 1",icon = icon("folder-open"), tabName = "subMenu1")
),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
),
actionButton('switchtab', 'Switch tab')
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")
),
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$switchtab, {
newtab <- switch(input$tabs,
"subMenu1" = "widgets",
"widgets" = "subMenu1"
)
updateTabItems(session, "tabs", newtab)
})
}
shinyApp(ui, server)
}
I would like manually expand the tree, select the menu and the submenu. Any suggestions are welcome. Thanks.
Update:
A working code with the complete solution is in Shiny expanding submenu items manually
I helped myself out defining some JavaScript, using the JavaScript interface extendShinyjs in shiny:
js$selectMenuItem(0)
js$selectMenuSubItem(2)
useShinyjs(),
extendShinyjs(text = jsSelectMenuItem),
extendShinyjs(text = jsSelectMenuSubItem)
select menuItem i
jsSelectMenuItem <- "shinyjs.selectMenuItem = function(i){
setTimeout(function(){
$('.treeview > a').eq(i).click();
}, 200);
}"
select menuSubItem i
jsSelectMenuSubItem <- "shinyjs.selectMenuSubItem = function(i){
setTimeout(function(){
$('.treeview-menu > li > a').eq(i).click();
}, 800);
}"