How do I make numericInput and selectInput next to each other instead of under each other? It is possible?
Executable code below:
library(shiny)
ui <- fluidPage(
column(4,
wellPanel(
numericInput("weight1", label = h4("Weight 1"), min = 0, max = 1, value = NA, step = 0.1),
selectInput("maxmin", label = h5("Maximize or Minimize"),choices = list("Maximize " = 1, "Minimize" = 2),
selected = ""))),
hr(),
column(8,
tabsetPanel(tabPanel("table1", DTOutput('table1')))))
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
splitLayout can be used to split the space.
wellPanel(
splitLayout(
numericInput("weight1", label = h4("Weight 1"), min = 0, max = 1, value = NA, step = 0.1),
selectInput("maxmin", label = h4("Maximize or Minimize"),choices = list("Maximize " = 1, "Minimize" = 2),
selected = "")))
The above code will produce equally sized inputs, but there is an optional argument, cellWidths, that can be used to specify the widths if another ratio is preferred. For example, adding cellWidths = c("40%", "60%") will make weight1 take 40% of the available space and maxmin the rest 60%.
Related
I have this R Shiny that gives me values of Meters covered based on the drill selected and the time selected by the user. Here is my code.
library(shiny)
library(dplyr)
# MyData <- read.csv("/Users/sonamoravcikova/Desktop/ShinyTest/ForShiny1.csv")
MyData <- structure(list(Drill = c("GP Warm Up", "5v2 Rondo", "11v11", "10v6 Drop
Behind Ball"), PlayerLoadPerMinute = c(7.72949670665213, 6.49382926701571,
9.67483408668731, 5.86770863636364), MetersPerMinute = c(69.9524820610687,
45.823744973822, 95.9405092879257, 58.185375), class = "data.frame", row.names
= c(NA, -4L)))
# Define UI ----
ui <- fluidPage(
titlePanel("Practice Planner"),
sidebarLayout(
sidebarPanel(
#Select number of drills
numericInput("num", h3("Number of Drills"), value = 1),
),
mainPanel(
#Show boxes for the number of drill selected and select drill type
selectInput("DrillName1",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider1",
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM1"),
br(),
conditionalPanel(
condition = "input.num > '1'",
selectInput("DrillName2",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider2",
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM2")),
br(),
conditionalPanel(
condition = "input.num > '2'",
selectInput("DrillName3",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider3",
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM3"))
)
)
)
# Define server logic ----
server <- function(input, output, session) {
#Calculate number of meters covered
lapply(1:10, function(x) {
output[[paste0("MpM", x)]] <- renderText({
chosendrill <- input[[paste0("DrillName", x)]]
MpM <- MyData %>%
distinct(MetersPerMinute, .keep_all = T)
MpM_text <- (MpM$MetersPerMinute[MpM$Drill == chosendrill]) * (input[[paste0("slider", x)]])
paste0("Meters covered: ", paste0(MpM_text, collapse = " "))
})
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
Now I'm trying to just add all of the values that I get for the individual drills together so that I will get Meters covered for the whole session but I have no idea how to do that. So if someone could help me out where to start I would appreciate it. Thanks
I am begginer in shiny an I am stucked adding feedback in my app.
I have tried a few things like write this code inside the eventReactive function like use the function feedBackDanger.
Below, there is a simplified full code with the ui, the idea is that i need the user get some Error (but not the console Error) if he set 'zero' in kind variable when mean is 3,6 or 9.
Also the actionButton 'simulate' should be disable when this condition is selected.
ui <- shinyUI(fluidPage(
titlePanel(h1("Simulation", align = 'center')),
sidebarLayout(
sidebarPanel(
numericInput(inputId = "n", label = "Size of Sample", min = 1,
step = 1, value = 1),
numericInput(inputId = "mean", label = "Mean of Sample", min = 1,
step = 1, value = 1),
numericInput(inputId = "var", label = "Variance", min = 1,
step = 0.25, value = 1),
radioButtons("kind", "Sample kind", choices = c("two", "zero")),
actionButton("simulate", "Simulate"),
width = 200
),
mainPanel(
plotOutput("distPlot", width = 500, height = 500)
)
)
))
# Define server logic required to draw a histogram
server <- shinyServer(function(input, output, session) {
s_fin <-function(n,
mean,
var,
kind){
a <- rnorm(n, mean, var)
if(kind == 'two'){
a <- a + 2
}
if(kind == 'zero'& mean %in% c(3,6,9)){
print('ERROR: function error')
stop(call. = T)}
return(a)
}
simulation <- eventReactive(input$simulate,{
s_fin(n = input$n,
mean = input$mean,
var = input$var,
kind = input$kind)
})
output$distPlot <- renderPlot({
hist(simulation())
})
})
shinyApp(ui, server)
The next code works to me (a just add useShinyFeedback() in ui.R, and put the error function instead of print):
library(shinyFeedback)
ui <- shinyUI(fluidPage(
useShinyFeedback(),
titlePanel(h1("Simulation", align = 'center')),
sidebarLayout(
sidebarPanel(
numericInput(inputId = "n", label = "Size of Sample", min = 1,
step = 1, value = 1),
numericInput(inputId = "mean", label = "Mean of Sample", min = 1,
step = 1, value = 1),
numericInput(inputId = "var", label = "Variance", min = 1,
step = 0.25, value = 1),
radioButtons("kind", "Sample kind", choices = c("two", "zero")),
actionButton("simulate", "Simulate"),
width = 200
),
mainPanel(
plotOutput("distPlot", width = 500, height = 500)
)
)
))
# Define server logic required to draw a histogram
server <- shinyServer(function(input, output, session) {
s_fin <-function(n,
mean,
var,
kind){
a <- rnorm(n, mean, var)
if(kind == 'two'){
a <- a + 2
}
if(kind == 'zero'& mean %in% c(3,6,9)){
showFeedbackDanger(
inputId = "mean",
text = "Not use mean 3, 6 or 9"
)
shinyjs::disable("simulate")
}else{
hideFeedback("mean")
shinyjs::enable("simulate")
}
return(a)
}
simulation <- eventReactive(input$simulate,{
s_fin(n = input$n,
mean = input$mean,
var = input$var,
kind = input$kind)
})
output$distPlot <- renderPlot({
hist(simulation())
})
})
shinyApp(ui, server)
I would like to fix the range in a shiny sliderInput such that it may only be dragged left or right, keeping the same range always. In the example below, the range is always kept to 10 but any range of 10 may be selected, e.g. 71-81 etc. Is it possible?
library(shiny)
ui <- fluidPage(
sliderInput(
inputId = "foo",
label = "Select Range",
min = 0,
max = 100,
value = c(50, 60),
step = 1,
dragRange = T
))
shinyApp(ui = ui, server = function(input, output) {})
Perhaps you are looking for this
library(shiny)
ui <- fluidPage(
sliderInput(
inputId = "foo",
label = "Select Range",
min = 0,
max = 100,
value = c(50, 60),
step = 1,
dragRange = T
))
server = function(input, output,session) {
observeEvent(input$foo[1], {
if (input$foo[1]<=90) mnval <- input$foo[1]
else mnval = 90
mxval = input$foo[1] + 10
updateSliderInput(session, "foo", min =0,max=100, value = c(mnval,mxval))
})
}
shinyApp(ui = ui, server = server)
I'm currently building an application in R-Shiny and having troubles with the location of the graph since I've added tabs to the application. I want to move the graph from the first tab from below the inputs to the right of them. I'm currently getting the following message from R.
bootstrapPage(position =) is deprecated as of shiny 0.10.2.2. The 'position' argument is no longer used with the latest version of Bootstrap. Error in tabsetPanel(position = "right", tabPanel("Drawdown Plot", plotOutput("line"), : argument is missing, with no default
Any help would be greatly appreciated! Code is below
ui <- fluidPage(
titlePanel("Drawdown Calculator"),
theme = bs_theme(version = 4, bootswatch = "minty"),
sidebarPanel(
numericInput(inputId = "pot",
label = "Pension Pot",
value = 500000, min = 0, max = 2000000, step = 10000),
numericInput(inputId = "with",
label = "Withdrawal Amount",
value = 40000, min = 0, max = 200000, step = 1000),
numericInput(inputId = "age",
label = "Age", value = 65, max = 90, min = 40),
sliderInput(inputId = "int",
label = "Interest",
value = 4, max = 15, min = 0, step = 0.1)),
mainPanel(
tabsetPanel(position = "right",
tabPanel("Drawdown Plot", plotOutput("line"),
p("This drawdown calculator calculates a potential drawdown outcome")),
tabPanel ("Breakdown of Drawdown Withdrawals",
tableOutput("View")),
))
)
Try this code -
library(shiny)
library(bslib)
ui <- fluidPage(
titlePanel("Drawdown Calculator"),
theme = bs_theme(version = 4, bootswatch = "minty"),
sidebarPanel(
numericInput(inputId = "pot",
label = "Pension Pot",
value = 500000, min = 0, max = 2000000, step = 10000),
numericInput(inputId = "with",
label = "Withdrawal Amount",
value = 40000, min = 0, max = 200000, step = 1000),
numericInput(inputId = "age",
label = "Age", value = 65, max = 90, min = 40),
sliderInput(inputId = "int",
label = "Interest",
value = 4, max = 15, min = 0, step = 0.1)),
mainPanel(
tabsetPanel(
tabPanel("Drawdown Plot",
p("This drawdown calculator calculates a potential drawdown outcome"),
tableOutput("View")),
tabPanel("Breakdown of Drawdown Withdrawals",
plotOutput("line"))
))
)
server <- function(input, output) {}
shinyApp(ui, server)
Here is my app embedded in my site. I want to get rid of the scroll widget below my app, this is due to the width of the tabsetPanel.
I embed the app using this code:
<iframe width="800" height="480" frameborder="0" src="http://spark.rstudio.com/alstated/meanvar/"></iframe>
App Codes:
ui.R
library(shiny)
# Define UI for application that plots random distributions
shinyUI(pageWithSidebar(
headerPanel(title = ""),
sidebarPanel(
sliderInput("size",
"Number of Observations",
min = 10,
max = 200,
value = 95),
sliderInput("mu",
"Mean",
min = -100,
max = 100,
value = 0),
sliderInput("sd",
"Standard Deviation",
min = 1,
max = 6,
value = 3),
checkboxInput(inputId = "indiv_obs",
label = "Show individual observations",
value = FALSE),
checkboxInput(inputId = "density",
label = "Show density estimate",
value = FALSE),
conditionalPanel(condition = "input.density == true",
sliderInput(inputId = "bw_adjust",
label = "Bandwidth Adjustment",
min = 0.2,
max = 2,
value = 1,
step = 0.2))
),
mainPanel(
tabsetPanel(
tabPanel("Plot",
plotOutput(
outputId = "histogram",
height = "400px",
width = "400px")),
tabPanel("Summary",
verbatimTextOutput(outputId = "datsummary"))
))
)
)
server.R
library(shiny)
# Define server logic required to generate and plot a random distribution
shinyServer(function(input, output) {
data <- reactive(rnorm(
n = input$size,
mean = input$mu,
sd = input$sd
))
output$histogram <- renderPlot({
hist(data(),
probability = TRUE,
xlab = "Data",
ylab = "Density",
main = "Histogram of Random Samples")
if(input$indiv_obs){
rug(data())
}
if(input$density){
dens <- density(data(), adjust = input$bw_adjust)
lines(dens, col = "blue")
}
})
output$datsummary <- renderPrint(summary(data()))
})
Any help is greatly appreciated!
I figure it now, I inspect the html code of the app on Shiny Homepage. And the tabsetPanel is adjusted using the <div> (Document Division) tag in html by setting the option class to either span1, span2, span3 and so on. The higher the suffix of the span the larger the width of the division. And I just add div() tag in my ui.R code:
div(
tabsetPanel(
tabPanel("Plot",
plotOutput(
outputId = "histogram",
height = "400px",
width = "400px")),
tabPanel("Summary",
verbatimTextOutput(outputId = "datsummary"))
), class = "span7")
Another way to adjust width (and height):
add
), style='width: 1000px; height: 1000px' # end of tabsetPanel
after tabsetPanel, no need for div() in this case
The examples above work in certain circumstances. I needed a more general solution. The following solution can be tailored to any situation. For example, your Shiny app could still be responsive.
My solution
First, create a div before the tabsetPanel and give it a class. Second, write a piece of jQuery/javascript to find the parent element of that div. Third, change the class of this parent element using javascript/jQuery. You can change the class into anything you like, for example, col-sm-12, col-sm-11, some other standard Bootstrap class or you can add and create your own class. Fourth, add the custom jQuery/javascript to your Shiny application (make sure that you save the .js-file in the www folder of your Shiny app).
Here is my example:
Javascript/jQuery (general.js):
$(function (){
$("div.delParentClass").parent().removeClass("col-sm-8").addClass("col-sm-12");
/* In addClass you can specify the class of the div that you want. In this example,
I make use of a standard Bootstrap class to change the width of the tabset: col-sm-12.
If you want the tabset to be smaller use: col-sm-11, col-sm-10, ... or add
and create your own class. */
});
Shiny UI
mainPanel(
tags$head(tags$script(src="general.js")),
div(class="delParentClass",
tabsetPanel(
tabPanel("Some panel", .....),
tabPanel("Some panel", .....),
tabPanel("Some panel", .....)
)
)
)
A different way to adjust the width of sidebarPanel and tabsetPanel was based on modifying the width property of the col-sm-4 and col-sm-8 CSS classes, respectively.
Using tag$head and tag$style it is possibile to add CSS directly to the Shiny UI.
See https://shiny.rstudio.com/articles/css.html for details.
This is not an elegant solution, but it works correctly.
Shiny UI
shinyUI(fluidPage(
tags$head(
tags$style(HTML("
.col-sm-4 { width: 25%;}
.col-sm-8 { width: 75%;}
"))
),
headerPanel(title = ""),
sidebarPanel(
sliderInput("size",
"Number of Observations",
min = 10,
max = 200,
value = 95),
sliderInput("mu",
"Mean",
min = -100,
max = 100,
value = 0),
sliderInput("sd",
"Standard Deviation",
min = 1,
max = 6,
value = 3),
checkboxInput(inputId = "indiv_obs",
label = "Show individual observations",
value = FALSE),
checkboxInput(inputId = "density",
label = "Show density estimate",
value = FALSE),
conditionalPanel(condition = "input.density == true",
sliderInput(inputId = "bw_adjust",
label = "Bandwidth Adjustment",
min = 0.2,
max = 2,
value = 1,
step = 0.2))
),
mainPanel(
tabsetPanel(
tabPanel("Plot",
plotOutput(
outputId = "histogram",
height = "400px",
width = "400px")),
tabPanel("Summary",
verbatimTextOutput(outputId = "datsummary"))
))
)
)