I would like to create a nice vertical stepper (like that) within my Shiny app, for which some of the steps would be displaying R/shiny widget/reactive values (such as graphs, tables, etc.). Is there any specific widget that allows that?
It could looks like something like this within ui.R:
ShinyStepper(vertical = TRUE,
linear = TRUE,
theme = "default",
step1.title = "Title of first step",
step1.body = {
h3("This is a reactive barplot"),
plotOutput(outputId = "reactive_barplot")
},
step2.title = ...
)
Related
I am having an issue where the data for my DT table is "bleeding" past the edge of the box in my fluid row.
Here is the tabPanel section
tabPanel("Table title", h1('dataset', style = 'color: #23A595'),
p('Here we will have a paragraph of explanatory text to talk about the graphs below. Here we will have a paragraph of explanatory text to talk about the graphs below. Here we will have a paragraph of explanatory text to talk about the graphs below. Here we will have a paragraph of explanatory text to talk about the graphs below. Here we will have a paragraph of explanatory text to talk about the graphs below.', style = 'color: black'),
fluidRow(
box(DT::dataTableOutput(outputId = "table"), width = NULL, solidHeader = TRUE, status = "primary"),
),
When the app is run here is the result of the render DT.
Here is what the data set looks like.
The red box highlights the issue.
Here is what i have tried:
First,
output$table<- renderDT(
outputtable,options = list(columns.width = "3px"
),
rownames= FALSE
)
Second,
fluidRow(box(DT::dataTableOutput(outputId = "table"),width = #),
)
I was under the impression that shiny just automatically calculates the size needed despite window size an such.
in simple terms, shiny creates box + add DT table to box = box with DT table INSIDE of it.
I want the highlighted issue to not happen what do I need to do?
If there is anything I can add let me know.
The scrollX comment above answered the question.
The local version of the dashboard looks different from the one deployed on the free Shiny server. To correct for this, I add some ccs and html to brute force the appearance. However, I am still running into some issues.
This is what it looks like locally:
This is what it looks like deployed on the shiny server:
Notice the weird symbols on the top left: (]*)?>)\1,
The symbols on the bottom left: 'TRUE TRUE TRUE'.
I have no idea what is causing this to happen. I've spent a lot of time tweaking the code, without any result.
I would really appreciate some insight! This issue only occurs when it is deployed on the server, and shows on BOTH tabs of the dashboard. :(
Here is my code:
library(shiny) # load the shiny package
library(ggplot2) # load the gglpot2 package if ploting using ggplot
library("shinythemes")
library(magrittr)
library(tidyverse)
library(shinyWidgets)
library(shiny)
library(shinymanager)
library(bsTools)
library(shinyBS)
# this was set placement to bottom, but selectize calls below were set to right set "right" here and no need to set it below
selectizeTooltip <- function(id, choice, title, placement = "right", trigger = "hover", options = NULL){
options = shinyBS:::buildTooltipOrPopoverOptionsList(title, placement, trigger, options)
options = paste0("{'", paste(names(options), options, sep = "': '", collapse = "', '"), "'}")
bsTag <- shiny::tags$script(shiny::HTML(paste0("
$(document).ready(function() {
var opts = $.extend(", options, ", {html: true});
var selectizeParent = document.getElementById('", id, "').parentElement;
var observer = new MutationObserver(function(mutations) {
mutations.forEach(function(mutation){
$(mutation.addedNodes).filter('div').filter(function(){return(this.getAttribute('data-value') == '", choice, "');}).each(function() {
$(this).tooltip('destroy');
$(this).tooltip(opts);
});
});
});
observer.observe(selectizeParent, { subtree: true, childList: true });
});")))
htmltools::attachDependencies(bsTag, shinyBS:::shinyBSDep)
}
ui <- fluidPage(navbarPage(
theme = shinytheme("superhero"),
# can't comment within this section like I'd prefer ---
# first - control the tooltip window- I added min-width and max-width
# tool tip to the top by using z-index (I think that's why the tip was hidden)
# -- however, it still wants to show the tip after selecting it and the tip is hidden then...
# then control font-size by the entire form - (labels and input boxes don't inherit the form's styles)
# I tried to set the styles for the labels here, but they wouldn't stick
# I captured the class names by visiting developer tools in my browser after rendering online
# the class labels were not all the same when looking at it locally and after uploading
tags$head(tags$style(HTML('.tooltip .tooltip-inner { min-width: 200px; max-width: 400px;
font-size: 1.5em; text-align:left; padding:10px; z-index: 2 !important;}
.shiny-input-container .control-label {margin-bottom: 1em;}
.selectize-dropdown .option .selectize-input {line-height:1.1em; font-size:2em!important;}
.well {min-height:200px; min-width:200px; font-size:1.5em!important;}'))),
tabPanel(
title = "Program Participation",
sidebarLayout(
sidebarPanel(
uiOutput("choose_prog"),
uiOutput("choose_name"),
selectizeTooltip(id="choose_name", choice = "group 1",
title = "group 1 definition this is a long definition that does not really display well within the narrow text box",
trigger = "hover"),
selectizeTooltip(id="choose_name", choice = "group 2",
title = "group 2 definition this is another long definition. When group 1 and group 3 is is selected, you no longer see this definition",
trigger = "hover"),
selectizeTooltip(id="choose_name", choice = "group 3",
title = "group 3 definition this does not show if all of the other groups are selected ",
trigger = "hover"),
),
mainPanel(
plotOutput("plot")
# br(),
)
)),
# SECOND TAB
tabPanel(title = "Additional Information/ Documentation",
pageWithSidebar(
headerPanel("Data sources and other information"),
sidebarPanel(
),
mainPanel("Place holder for information about data"
)
)
)
))
server <- function(input, output) {
# result_auth <- secure_server(check_credentials = check_credentials(credentials))
output$plot <- renderPlot({
plot(mtcars$wt, mtcars$mpg)
}, height = 800, width = 'auto')
# Drop down selection to chose the program
output$choose_prog <- renderUI({
selectInput("program",
label = HTML('<font style="color:orange; font-size:2em;">Select a program:</font>'),
choices = c("A","B","C"))
})
# Drop down for name
output$choose_name <- renderUI({
# SelectInput works, but this only allows the selection of a SINGLE option
selectInput("names",
label = HTML('<font style="color:orange; font-size:2em;">Select user group of interest:</font>'),
choices = c("group 1", "group 2", "group 3"),
multiple = T)})
observeEvent(input$choose_name, {
updateSelectizeInput(session, "choose_name", choices = c("group 1", "group 2", "group 3"))
})
}
shinyApp(ui = ui, server = server)
Your rending true true true (and other appearing randomness) is eliminated by updating the libraries to what you're actually using.
For all of this programming, you only need to call:
library(shiny)
library(shinythemes)
library(tidyverse)
You used pageWithSidebar() in your second tabPanel. That function is deprecated. If you're going to use this app for a while, change that to fluidPage() or fluidRow().
When I rendered this, it kept wanting to put the plot below the sidebar. You should add fluidRow() in the first tabPanel(). That way it will try to render them next to each other unless the fit is an issue.
You have the plot at a set height and an auto width. I'm not sure exactly how shiny reads and renders this. It may be useful to lock the aspect ratio.
In the tags$head... call, I added .column-sm-8 {min-width:400px;} to make the main panel of the first tabPanel have a minimum width. It looks like this class (so this minimum width) will apply to any mainPanel you use.
Lastly, in the server function, you have the plot than the input form. Since it looks like your building the complexity as you go, it would be ideal to order the content here as it appears, when it gets really complex it will make following your work a lot easier. R doesn't care what order you put it in, though.
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")))
From the shiny dashboard github, I've gathered that it's possible to create drop down menus at the top right of the header, but there are only 3 "types" (messages, notifications, and tasks).
https://rstudio.github.io/shinydashboard/structure.html#structure-overview
Is there a method for creating a custom dropdown? I'd like to make a settings dropdown, where I give the user some checkboxes that they can use to adjust the dashboard in ways (displaying/hiding things, filtering data, etc.)
I customized one of the three types of menu to allow this. You could then add actionItem(s) for items. tabSelect property when true simulate the selection of a sidebarMenuItem.
dropdownActionMenu <- function (..., title=NULL, icon = NULL, .list = NULL, header=NULL) {
items <- c(list(...), .list)
lapply(items, shinydashboard:::tagAssert, type = "li")
type <- "notifications" # TODO créer action + CSS
dropdownClass <- paste0("dropdown ", type, "-menu")
tags$li(class = dropdownClass, a(href = "#", class = "dropdown-toggle",
`data-toggle` = "dropdown", icon, title), tags$ul(class = "dropdown-menu",
if(!is.null(header)) tags$li(class="header",header),
tags$li(tags$ul(class = "menu", items))))
}
actionItem = function (inputId, text, icon = NULL, tabSelect=FALSE) {
if(!is.null(icon)) {
shinydashboard:::tagAssert(icon, type = "i")
icon <- tagAppendAttributes(icon, class = paste0("text-", "success"))
}
if(tabSelect) {
tags$li(a(onclick=paste0("shinyjs.tabSelect('",inputId,"')"),icon,text))
} else {
tags$li(actionLink(inputId,text,icon))
}
}
javascript function to select tab (to be inserted after useShinyjs() in body)
extendShinyjs(text="shinyjs.tabSelect=function(tabName){$('a[data-value='+tabName+']').click();}")
Sample code
dashboardHeader(
dropdownActionMenu(title="test",
actionItem("mnuFirst","First"),
actionItem("mnuSecond","Second")
)
)
Shiny Dashboard is based on admin LTE. So the existing type of drop downs are designed for admin LTE use case, which is quite different from many Shiny app usage.
If something is not even available in admin LTE, it's less likely to be supported in Shiny dashboard.
For your specific question, you can put some controls in the side bar. Another possibility is to use the wrench icon in box, which is not implemented in Shiny yet.
I have almost completed a web app, which allows the user to subset the data frame underlying the web app, using the text input control created by textInput; see my related question for parsing the string as an expression.
It would be more user friendly if I could increase the width of this text input control. Does anybody know how to do this?
Cheers for any help.
If your textInput is as follows:
textInput(inputId="someid", label="somelable", value = 0.0)
tags$head(tags$style(type="text/css", "#someid {width: 150px}")),
you can add some css.
or
tags$head(
tags$link(rel = 'stylesheet', type = 'text/css', href = 'styles.css'),
)
and add an appropriate entry in styles.css
I created a custom.css file for things like this.
Put the custom.css file in a www directory in the app home directory.
Add this line to the custom.css file to make all of the selectize inputs fit the full width of their containers.
.shiny-input-container:not(.shiny-input-container-inline) {
width: 100%;
}
This is very useful for text inputs or dropdowns that have options with long names, or many options. It also just makes the app look more full. I put all of my filters at the top of the page and there is a lot of white space if I don't force the inputs to fill their containers.
Then you can control your input size easily in the ui.R file by setting the width of the column that contains the input container. Something like this...
fluidRow(
column(4, offset = 0, align = 'center', uiOutput(ns("select_category_type"))),
column(4, offset = 0, align = 'center', uiOutput(ns("select_category_group"))),
column(4, offset = 0, align = 'center', uiOutput(ns("select_category")))
),
fluidRow(
column(6, offset = 3, align = 'center', uiOutput(ns("select_year")))
)
```
You will also need to load you custom.css file in the ui.R file. You can do this as the first statement in the dashboardBody function if using shiny dashboard, or in the fluidPage function if using the standard ui.
dashboardBody(
includeCSS("www/custom.css"),
tabItems(...