R Shiny selectInput and submitButton side by side - r

I am working on a Shiny app in R. The app is run by shiny server running on linux.
I need to create a side by side selectInput field and submitButton. I made the following attempt.
from my ui.r
div(style="display:inline-block",
selectInput("input$GeneVariable4",
label = h4(""),
choices = (Choices_cd),
multiple = TRUE,
selected = c("Slc26a5","Sri"),
selectize = TRUE,
width = '400px'
)
),
div(style="display:inline-block",
submitButton("Submit")
),
This code generates the following result
The problem with this is that there is a slight offset between the selectInput field and the submitButton. It is ugly and I hate it.
Does anyone know how i might solve this issue. I have tried adding br(), spaces but it just shifts the offset up or down and doesn't eliminate it.
Any advice on how to get these side by side would be much appreciated. Additionally the submit button cant be placed below because the selectInput drops down with choices when selected, obscuring any submit button placed underneath the bar.

You can use fluidRow and column
fluidRow(column(4,
selectInput(
"input$GeneVariable4",
label = h4(""),
choices = (Choices_cd),
multiple = TRUE,
selected = c("Slc26a5", "Sri"),
selectize = TRUE,
width = '400px'
)
),
column(4, offset = 1,
submitButton("Submit")))

Related

Weird behavior of selectizeInput

In the Shiny App below, I am facing a very strange behavior, where selectInput box slides downwards when I type something in this box. Also, the text inside selectInput box moves towards the right while I type in this box. I have spent a lot of time to find out the reason for this problem but could not figure it out. Can someone point out the mistake I am doing causing this strange behavior?
library(shiny)
library(shinydashboard)
library(highcharter)
siderbar <- dashboardSidebar(
sidebarMenu(
selectizeInput(inputId = "select_by", label = "Select by:", choices = NULL, multiple = FALSE, options = NULL)
)
)
body <- dashboardBody(
fluidRow(
tabBox(
side = "right",
selected = "Tab1",
tabPanel("Tab1", "Tab content 1", highchartOutput("tabset1Selected"))
)
),
)
shinyApp(
ui = dashboardPage(
dashboardHeader(title = "tabBoxes"),
siderbar,
body
),
server = function(input, output, session) {
selectedVal <- reactiveValues()
updateSelectizeInput(session, "select_by", choices = c(as.character(1:10000)), selected = 2, server = TRUE)
output$tabset1Selected <- renderHighchart({
selectedVal <- input$select_by
print(highcharts_demo())
})
}
)
We were on the right track. It has something to do with selectize.js updating the items from the server. You can verify that by setting the loadThrottle option to 5000. This option determines how long the widget waits "before requesting options from the server" (see the manual). Now you have to wait exactly 5 seconds and then the select widget flickers.
The issue seems to be caused by a CSS conflict. selectize.js adds a CSS class to the widget. If you remove that feature, the flicker goes away.
selectizeInput(inputId = "select_by", label = "Select by:",
choices = NULL, multiple = FALSE,
options = list(loadThrottle=200, loadingClass=""))
loadingClass sets a specific CSS class (default: 'loading') while loading data from the server. Purpose: to change how the widget looks and communicate to users that an update is in progress.
loadThrottle does not need to be set. It's default is 300. You can set it to any value that suits your needs.
Details
highcharter defines it's own CSS class names loading with these specs:
.loading {
margin-top: 10em;
text-align: center;
color: gray;
}
That is the reason for the CSS conflict. The widget gets a top margin and it's content moved to the center, because the browser does not distinguish the source of the class. It only sees some CSS that fits and uses it. This image shows where you need to look:

In R Shiny, use textOutput to dynamically populate downloadbutton's label

In R Shiny I am trying to dynamically set a download button's label using reactive renderText and textoutput.
It works as expected but the label is always shown in the new line, and hence the button looks wacky next to a regular button
as shown here
Backend logic is -
In server.R, an input field's value is used to generate conditional labels
output$mycustomlabel <- renderText({ if(input$inputtype=="One") return("Download label 1") else return("Download label 2")})
Then in UI.R, that label is used as
downloadButton("download.button.test", textOutput("mycustomlabel"))
Can someone guide why does it display text on new line, and how can I keep it on same line?
If you want to change the button label you probably need to update it with javascript.
An easier approach could be to have two different buttons and use conditional panels to display one of the buttons:
ui <- fluidPage(
radioButtons('inputtype', 'Set label', c('One', 'Two')),
conditionalPanel(
'input.inputtype == "One"',
downloadButton('btn1', 'Download label 1')
),
conditionalPanel(
'input.inputtype == "Two"',
downloadButton('btn2', 'Download label 2')
)
)
Note that with this approach you do need two observers in the server function.
I'm doing this same thing with a dynamic label on a downloadButton. In my case, I want the user to choose between downloading a dataframe as an Excel file or a CSV file.
Here's what I'm doing:
In the ui definition, where you want the button to show up, use
uiOutput( 'myCustomButtonUI' )
In the server definition, include:
output$myCustomButtonUI <- renderUI({
myCustomLabel <- 'Placeholder'
if( input$inputtype == 'One' ) myCustomLabel <- 'Download Label 1'
if( input$inputtype == 'Two' ) myCustomLabel <- 'Download Label 2'
downloadButton( inputId = 'download.button.test',
label = myCustomLabel )
})
output$download.button.text <- downloadHandler(
filename = "<some filename>",
content = .... <go look up downloadHandler() if you're unfamiliar> ..."
)
The idea is that, because you want your button to be dynamic, it needs to be rendered on the server side. The output of the server side is a tiny piece of UI that is placed in your larger UI by the uiOutput function.

Inserting a common text/box inside all the tabPanels of a navbarMenu in R shiny

I'm trying to create an Rshiny application and I'm stuck with inserting a common value inside all the tabs of a navbarmenu. When I'm trying it is getting inserted to all the tabs which are not even a part of the navbarMenu.
Can somebody suggest me a solution? than you in advance
This is my code
ui <- fluidPage(
sidebarPanel(
selectInput("variable", "Select an SKU:", materials, selected = '')
),
mainPanel(
navbarPage("DEMAND PREDICTION!",
theme = shinytheme("flatly"),
tabPanel("Home",
h1("Time series forecasting"),
verbatimTextOutput("summary_1")
),
tabPanel("Histogram",
fluidRow(column(3,
wellPanel(selectInput("variable", "Select an SKU:", materials, selected = ''),
selectInput("market", "Select a market:", choices = NULL)
))
),
mainPanel(
plotlyOutput("hist"),
h4("Sales per Country"),plotOutput("map")
)),
navbarMenu("Exploratory Analysis",
tabPanel("Line graph",
plotlyOutput("exploratory")),
tabPanel("Box plot", plotlyOutput("boxplot")),
tabPanel("Seasonal plot", plotlyOutput("seasonal")),
fluidRow(column(3,"hello")))
)))
This is just an overview of my code. Here inside the navbar menu I'm trying to add a common field that can be reflected in all panels within the navbarMenu. Instead it is shown in other tabs which are not even a part of navbarMenu.

How to display a hover in the box element inside fluidRow in shiny app

I have a code which has multiple fluidRows and every fluidrow comprises of multiple collapsible box elements which are default collapsed,
my concern is to display a hover when the box is collapsed on the shiny app, depicting "you can open the box to see the data and also a small brief about the data present"
With BSTooltip functionality I am able to show a hover on the data inside the box but not on the collapsible box.
This is a major functionality.
Please help.
fluidRow(
box(
id = "djc",
title = "BY SEGMENT",
width = 12,
status = "primary",
solidHeader = TRUE,
align='center',
collapsible = TRUE,
collapsed = TRUE,
DT::dataTableOutput("tab_PF2")
),
bsTooltip("djc", "This is a Table which talks about all the segments and there data shift and book shift respectfully", placement = "bottom", trigger = "hover",
options = NULL)
))
Above is one fluid row in which I can depict tooltip on the data.
I was able to achieve your question by applying js on columns not on column names.
library(shiny)
shinyApp(
ui = fluidPage(
DT::dataTableOutput("mtcarsTable")
),
server = function(input, output) {
output$mtcarsTable <- DT::renderDataTable({
DT::datatable(datasets::mtcars[,1:3],
options = list(rowCallback = JS(
"function(nRow) {",
"var full_text = 'Test1';",
"var full_text1 = 'Test2';",
"$('td:eq(0)', nRow).attr('title', full_text);",
"$('td:eq(1)', nRow).attr('title', full_text1);",
"}")
)
)
})
}
)
I hope this helps you.
Not sure of your exact use case, but you can use JavaScript to add a title attribute to all the box collapse buttons.
Add this code to your ui:
tags$head(tags$script("
$( document ).ready(function() {
$('.btn.btn-box-tool').attr('title', 'hovering info');
});
"))

Show/Hide button on tab select R shiny

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.

Resources