I have a button in my ui.R that I want to be shown only when "Summary" tab is selected, so I thought of this code
fluidRow(
column(4,
column(12,id="sub",
actionButton("submit", "SUBMIT", width = "100%"))),
column(8,
bsCollapse(id = "collapse7", open = "Results",
bsCollapsePanel("Results",
tabsetPanel(
tabPanel("Summary",
tags$script(HTML("document.getElementById('sub').style.visibility = 'visible';")))
tabPanel("Plot",
tags$script(HTML("document.getElementById('sub').style.visibility = 'hidden';"))))
))))
The problem is, the button is hidden even though in my first tab it should be visible and also when i go to Plots and back to Summary, the button stays hidden.
After looking at: How to use tabPanel as input in R Shiny?
I decided to play with observeEvent and the input$tabset option. The result is 100% working and it's really simple. Here's the code:
observeEvent(input$choices, {
choice = input$choices
if(choice == "Summary")
{
runjs(
"document.getElementById('submit').style.visibility = 'visible';"
)
}
else
{
runjs(
"document.getElementById('submit').style.visibility = 'hidden';"
)
}
})
Also, I found out why my previous code wasn't working, it was due to the fact that when the UI was initialized, the button element kept the last style modification (the hidden one) and it didn't change depending on the tab I have selected, since its not reactive.
Related
This seems like a very simple question, but I have searched and searched!
I am using selectize to select multiple items from a list in a selectInput dropdown menu. Below it I have a Submit button to perform some action on the list. As you add multiple entries, the selectInput box grows, and the button dynamically moves down the sidebar, but when you open the dropdown menu to see the list of options, the Submit button is hidden. I would like the button to dynamically jump down and stay visible when you open the dropdown, and conversely to jump back up when it closes.
I can't for the life of me...
I know how to change the default size of the dropdown with css
.selectize-dropdown-content { max-height: ... },
and I can add a spacer to keep the Submit button always visible, but that's wasted space once you're done selecting items.
sample code attached
library(shiny)
library(shinydashboard)
# long entries that will increase number of lines in the selectInput box
nonsenseWords <- c(replicate(25,paste0(sample(letters, 10, replace=TRUE),collapse="")))
ui <-
dashboardPage(
dashboardHeader(),
dashboardSidebar(
fluidRow(style = "margin: 1%",
selectInput("tall_list",
"Stop covering my buttons!",
nonsenseWords,
multiple = TRUE,
selected=nonsenseWords[c(1,5,7,11,20)]
)
# The line below puts static space between the dropdown and the submit button -- this is what I want to remove
# ,tags$div(style = "height: 16em;")
)
,fluidRow(style = "margin: 1%",
actionButton("submit", "Submit")
)
),
dashboardBody(
dataTableOutput("choice")
)
)
server <- function(input, output, session) {
output$choice <- renderDataTable({
req(input$submit)
return(data.frame("Chosen Words" = c(input$tall_list)))
})
}
shinyApp(ui, server)
Use this CSS:
dashboardBody(
tags$head(
tags$style(".selectize-dropdown {position: static}")
),
dataTableOutput("choice")
)
i am creating an user registration application which accepts the user inputs like:username,Fullname,Email,contact number.
After clicking create button i am able to display modal message stating user registered . Onclick of close button i want my tabpanel created to reset all the textinput to its original data.
1)Created one tabpanel with title.
2)Created all the input and its types.
3)Created Modal successfully.
4)Even tried with shinyjs::reset() funtion as well.
Code for Ui.R:
tabPanel(title="User Management",id ="user",shinyjs::useShinyjs(),
fluidRow(
column(5,textInput("uname","User Name")),
column(5,textInput("fname","Full Name"))),
fluidRow(
column(5,textInput("email","Email Id")),
column(5,numericInput("contactnum","Contactnumber",value=NULL))),
fluidRow(
column(5,selectInput("country", label = "Country:",
choices = list("India","USA"),
selected = 1)),
column(5,selectInput("state", label = "State:",
choices =list("Karnataka","Kerala"),
selected = 1))),
fluidRow(column(5,numericInput("zip","ZIP Code",value=NULL)),
fluidRow(
column(5,passwordInput("pwd1","Password")),
column(5,passwordInput("pwd2","Confirm Password"))),
fluidRow(
column(12,actionButton("userCreate", "Create User"),
style="color: #fff;
background-color: #337ab7; border-color: #2e6da4"))),
br(),
)
)
Server.R:
observeEvent(input$userCreate,{
if(postuser() == 200)
{
showModal(modalDialog(
title = "Success",
"User is successfully added!"
footer = tagList(
actionButton("Close", "Close")
)
)))
}
})
observeEvent(input$Close,{
reset("user")
}
)
Update and Tries:
Even tried with shinyjs::reset("user") funtion and shinyjs::js$reset("user")function as well.
Please help me out with this . And i need logical code for list of all the counties and states.
Thanks in Advance
Try
observeEvent(input$Close,{
#reset("user")
shinyjs::reset("uname")
shinyjs::reset("fname")
#the remaining fields id's you would like to reset
}
The problem was giving the wrong div id's to reset, hence nothing happened after click close. To understand what I'm talking about have a look at
print(tabPanel(title="User Management",id ="user",shinyjs::useShinyjs(),
fluidRow(
column(5,textInput("uname","User Name")),
column(5,textInput("fname","Full Name")))))
is there any way to show all of the contents in the mainPanel only when the user clicks the action button? ive been searching the internet for awhile for the answer but couldn't really find an answer. i know i can use hidden - it works on smaller elements inside the mainPanel, such as showing a picture on click but doesn't work on the whole mainPanel itself. any suggestions? finding a way to wrap the whole main panel inside a hidden instead of each element in the mainPanel wrapped in a hidden would be easier i think but i can't seem to find a way to make it work.
in dashboard body:
fluidRow(
column(12, actionButton("analyze", "Fetch Data!", width = "100px"))),
hidden(
mainPanel(
hidden( (htmlOutput("artistpic")), // this works fine & shows on button click
infoBoxOutput("approvalBox"))
)),
server:
pic <- eventReactive(input$analyze2, {
print(get_id_picture()[3])
url = toString(get_id_picture()[3])
print(url)
url
})
output$artistpic <- renderText({c('<img src="',pic(),'"width="17%" height="17%">')})
This is easy with shinyjs.
Just surround mainPanel() with a div() tag so that you can use it's id for toggling it's visability and start the app with the div tag hidden using hidden() like in the following example:
# ui.R
fluidPage(
useShinyjs(),
actionButton("toggle.main.button", "Toggle Main"),
div(id = "main",
mainPanel(
p("This paragraph is in main."),
p("This one too!")
)
) %>% shinyjs::hidden()
)
# server.R
library(shinyjs)
function(input, output, session) {
# Toggling visability of main on button click.
observeEvent(input$toggle.main.button, {
shinyjs::toggle("main")
})
}
I am using the shiny dashboard template to generate my web UI.
I'd like to dynamically generate an infobox when a computation is completed with a link directed to one of the tabItems in dashboardBody.
For example,
I can put this in my tabItem1 output,
renderInfoBox({
infoBox("Completed",
a("Computation Completed", href="#tabItem2"),
icon = icon("thumbs-o-up"), color = "green"
)
})
But the problem is that when I click the link, it does nothing. I would like it jumps to tabItem2. The link href seems valid when I hover on it.
Thanks!
Update:
Other than using Javascripts, looks like using actionLink and updateTabItems functions in shinydashboard package will work as well.
I apologize for the lengthy code sample, but I had to copy an example with tabItems from the shinydashboard homepage.
Your approach has only few problems. First, if you would inspect the menuItems, you'd see that the actual tab's id is not tabItem2, but shiny-tab-tabItem2. This, plus the extra attribute data-toggle="tab" within the a tag would suffice to open the desired tab. Snippet:
a("Computation Completed", href="#shiny-tab-tabItem2", "data-toggle" = "tab")
But, this has its limits. First and most obvious, the state of the menuItem in the sidebar is not set to active. This looks very odd and one might not be convinced, that one has been moved to another tab.
Second, and less obvious, if you listen to tab changes (on the server side), you will not get information about this tab switch. Those are triggered by the menuItem being clicked, and the tab itself will not report if it is visible or hidden.
So, my approach will be to simulate that the corresponding menuItem is clicked, and thus, all the above problems are solved.
Code example:
library(shiny)
library(shinydashboard)
ui <- shinyUI(
dashboardPage(
dashboardHeader(title = "Some Header"),
dashboardSidebar(
sidebarMenu(
menuItem("Computations", tabName = "tabItem1", icon = icon("dashboard")),
menuItem("Results", tabName = "tabItem2", icon = icon("th"))
)
),
dashboardBody(
tags$script(HTML("
var openTab = function(tabName){
$('a', $('.sidebar')).each(function() {
if(this.getAttribute('data-value') == tabName) {
this.click()
};
});
}
")),
tabItems(
tabItem(tabName = "tabItem1",
fluidRow(
box(plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
),
infoBoxOutput("out1")
),
tabItem(tabName = "tabItem2",
h2("Widgets tab content")
)
)
)
)
)
server <- function(input, output){
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
output$out1 <- renderInfoBox({
infoBox("Completed",
a("Computation Completed", onclick = "openTab('tabItem2')", href="#"),
icon = icon("thumbs-o-up"), color = "green"
)
})
}
shinyApp(ui, server)
Note, that the only important thing is the onclick property, not an href. This means, that every div or other element can be used to create this link. You could even have just the thumbs-up image with this onclick command.
If you have more questions, please comment.
Best Regards
Edit: Whole infoBox clickable.
This is an answer to a comment by OmaymaS. The point was to make the infoBox a clickable container. To achieve this, one can define a new function that makes a somewhat different infoBox. The custom box will be as follows:
customInfoBox <- function (title, tab = NULL, value = NULL, subtitle = NULL, icon = shiny::icon("bar-chart"), color = "aqua", width = 4, href = NULL, fill = FALSE) {
validateColor(color)
tagAssert(icon, type = "i")
colorClass <- paste0("bg-", color)
boxContent <- div(class = "info-box", class = if (fill) colorClass,
onclick = if(!is.null(tab)) paste0("$('.sidebar a')).filter(function() { return ($(this).attr('data-value') == ", tab, ")}).click()"),
span(class = "info-box-icon", class = if (!fill) colorClass, icon),
div(class = "info-box-content",
span(class = "info-box-text", title),
if (!is.null(value)) span(class = "info-box-number", value),
if (!is.null(subtitle)) p(subtitle)
)
)
if (!is.null(href)) boxContent <- a(href = href, boxContent)
div(class = if (!is.null(width)) paste0("col-sm-", width), boxContent)
}
This code is copied from the original infoBox function definition and only the line with onclick is new. I also added the openTab function (with some twitches) right inside the container such that you dont need to worry where to put this function inside the view. Might be a bit overloaded i feel.
This custom info box can be used exactly like the default one and if you pass the additional tab argument, the link to the sidebar is added.
Edit: Subtitle exploit
As Alex Dometrius mentioned, the use of subtitle crashes this functionality. This is because the script tag that was inserted, on accident, was used as the subtitle argument in order to be rendered with the box. To free up this spot, I edited the main example up top such that the script tag is sitting top level in the dashboardBody (literally anywhere in the ui would be fine).
(To avoid confusion: in Version 1, the tags$script was supplied inside of infobox where it was interpreted as the subtitle parameter.)
I want to create a welcome message for when a user first opens the shiny webpage. Currently I have it such that it is constantly on the first tabPanel. Is there a way to make it disappear when the user navigates away and then back to that panel?
fluidRow(
column(width=12,
tabsetPanel(type = "tabs", id = "tabs1",
tabPanel("Express Usage", wellPanel("Welcome! Please select the libraries you are interested in viewing from below and use the tabs to navigate between graphs. It is best to limit your selection to no more than 5 libraries at a time"), plotOutput("express_Plot", height=400)),
tabPanel("Juvenile Usage", plotOutput("juvenile_Plot", height=400)),
tabPanel("test", h3(textOutput("text_test")))))
),
You can set the value attribute for all your tabPanels accordingly.
In this way, you can tell, in server.R, which tab is currently selected by reading input$tabs1, where tabs1 is the id you set for the tabsetPanel.
Replace the wellPanel with a uiOutput element, and update the UI elements according
to:
The current panel.
The times the panel has been visited.
ui.R
library(shiny)
shinyUI(fluidPage(
fluidRow(
column(width=12,
tabsetPanel(type = "tabs", id = "tabs1",
tabPanel("Express Usage",
uiOutput("welcome"), # replace the wellPanel
plotOutput("express_Plot", height=400), value="ex_usage"),
tabPanel("Juvenile Usage", plotOutput("juvenile_Plot", height=400), value="juv_usage"),
tabPanel("test", h3(textOutput("text_test")))), value="test")
)
)
)
server.R
library(shiny)
shinyServer(function(input, output, session){
visits <- reactiveValues(times = 0)
output$welcome <- renderUI({
if (input$tabs1 == "ex_usage") {
isolate(visits$times <- visits$times + 1)
if (isolate(visits$times) == 1) {
return (wellPanel("Welcome! Please select the libraries you are interested in viewing from below and use the tabs to navigate between graphs. It is best to limit your selection to no more than 5 libraries at a time"))
}
else {
return ()
}
}
})
})