sliderInput("myslider", "Slider:", min=1, max=100, value=6)
returns a slider with tickmark labels at 1, 11, 21, 31,...,91 and 100.
I would love the heuristic that is determining these tickmark labels to return more reasonable values of 1, 10, 20, 30,, ...90, 100.
I imagine this comes up a lot, as a slider from 1 to 100 is a very common one. (If you set min=0, it does show the desired tickmark labels, but in many apps, you don't want the input to be 0.
Currently, there is no way to supply user-defined tickmark labels to sliderInput. Is there a workaround just for the labels?
A similar question is posted here, but it talks about creating user-defined tick marks, not the labeling.
In https://groups.google.com/forum/#!topic/shiny-discuss/AeAzR4p2h1g is a solution of this problem:
ui <- pageWithSidebar(
headerPanel("Slider labels"),
sidebarPanel(
uiOutput("slider")
),
mainPanel()
)
server <- function(input, output) {
output$slider <- renderUI({
args <- list(inputId="foo", label="slider :", ticks=c(90,95,99,99.9), value=c(2,3))
args$min <- 1
args$max <- length(args$ticks)
if (sessionInfo()$otherPkgs$shiny$Version>="0.11") {
# this part works with shiny 1.5.0
ticks <- paste0(args$ticks, collapse=',')
args$ticks <- T
html <- do.call('sliderInput', args)
html$children[[2]]$attribs[['data-values']] <- ticks;
} else {
html <- do.call('sliderInput', args)
}
html
})
}
runApp(list(ui = ui, server = server))
By now this can be done using htmltools::tagQuery:
library(shiny)
library(htmltools)
ui <- basicPage(h1("Custom sliderInput ticks"),
{
customTicks <- seq_len(15)
customSlider <- sliderInput(
inputId = "sliderinput",
label = "sliderInput",
min = 1,
max = max(customTicks),
value = 7,
step = 1,
ticks = TRUE
)
tagQuery(customSlider)$find("input")$addAttrs("data-values" = paste0(customTicks, collapse = ", "))$allTags()
})
server <- function(input, output, session) {}
shinyApp(ui = ui, server = server)
Related
I am trying to create an easy application with R shiny. However I could not get the desired output I want. I am neither experienced in shiny nor an expert of R. Here is the code:
library(shiny)
ui <- fluidPage(
headerPanel("deneme"),
checkboxGroupInput("plots", "draw plots:",
choices=list("histogram", "qq","both"),
selected="histogram"),
sidebarPanel(
numericInput("mean", "rn mean", value=seq(0:5), min=0, max=5),
numericInput("sd","standart deviation",value=seq(0:5),min=0,max=5),
numericInput("n", " number of observations ", value=seq(30,50))
),
mainPanel(
textOutput("text1"),
fluidRow(splitLayout(cellWidths = c("60%", "40%"),
plotOutput("graph1"), plotOutput("graph2")))
)
)
server <- function(input, output) {
norm<-reactive({
set.seed(6)
rnorm(input$n,mean=input$mean,sd=input$sd)
})
output$text1<-renderText({
paste("A random normal distrubution of",
input$n, "observations is generated with parameters mean",
input$mean,"and standart deviation", input$sd)
})
output$graph1<-renderPlot({
if(identical(input$plots,"histogram")){
req(norm())
hist(norm())
}
})
output$graph2<- renderPlot({
if(identical(input$plots,"qq")) {
req(norm())
qqnorm(norm(), pch = 1, frame = FALSE)
qqline(norm(), col = "steelblue", lwd = 2)
}
})
observe({
if(identical(input$plots,"both")) {
req(norm())
output$graph1<- renderPlot({
hist(norm())
})
output$graph2<- renderPlot({
qqnorm(norm(), pch = 1, frame = FALSE)
qqline(norm(), col = "steelblue", lwd = 2)
})
}
})
}
shinyApp(ui = ui, server = server)
I want the plot layout change dynamically according to selection of checkboxGroupInput. When I click histogram or qq I want it to plot an unsplit frame, into only one plotting frame. Whereas when I click both I want the plots to be seen together in a split frame of two rows. When unclicked the layout must be reset to one frame again. I know I am not doing it right by splitting the layout in ui first. I saw something about renderUI function but could not understand how it works. Thanks in advance.
Also I got some error related to if statement:
Warning in if (!is.na(attribValue)) { :
the condition has length > 1 and only the first element will be used
Warning in charToRaw(enc2utf8(text)) :
argument should be a character vector of length 1
all but the first element will be ignored
Here is a start, you don't need the observer, you can just add an if statement to each renderPlot.
Update: The trick to getting the plots to update dynamically is to assign them into a list and then render the list of plots with renderUI, the only caveat to this is that I am unaware of a way to get these plots to render side-by-side at the moment, it probably has something to do with adding some div tags...
Update 2: To get the plots side by side we just need to wrap the plotOutput in column
library(shiny)
ui <- fluidPage(
headerPanel("deneme"),
checkboxGroupInput("plots", "draw plots:",
choices=list("histogram", "qq"),
selected="histogram"),
sidebarPanel(
numericInput("mean", "rn mean", value=1, min=0, max=5),
numericInput("sd","standart deviation",value=1,min=0,max=5),
numericInput("n", " number of observations ", value=30)
),
mainPanel(
textOutput("names"),
textOutput("text1"),
fluidRow(uiOutput("plot_list"))
)
)
server <- function(input, output) {
norm<-reactive({
set.seed(6)
rnorm(input$n,mean=input$mean,sd=input$sd)
})
output$text1<-renderText({
paste("A random normal distribution of",
input$n, "observations is generated with parameters mean",
input$mean,"and standart deviation", input$sd)
})
output$histogram <- renderPlot({
req(norm())
if("histogram" %in% input$plots){
hist(norm())
}
})
output$qq <- renderPlot({
req(norm())
if("qq" %in% input$plots){
qqnorm(norm(), pch = 1, frame = FALSE)
qqline(norm(), col = "steelblue", lwd = 2)
}
})
output$plot_list <- renderUI({
plot_output_list <- lapply(input$plots,
function(plotname) {
column(width=5, plotOutput(plotname)) ##wrap the plotOutput in column to render side-by-side
})
# Convert the list to a tagList - this is necessary for the list of items
# to display properly.
do.call(tagList, plot_output_list)
})
}
shinyApp(ui = ui, server = server)
You can have a single plotOutput and use mfrow to split it into two panels, like this:
library(shiny)
ui <- fluidPage(
headerPanel("deneme"),
radioButtons("plots", "draw plots:",
choices=list("histogram", "qq","both"),
selected="histogram"),
sidebarPanel(
numericInput("mean", "rn mean", value=seq(0:5), min=0, max=5),
numericInput("sd","standart deviation",value=seq(0:5),min=0,max=5),
numericInput("n", " number of observations ", value=seq(30,50))
),
mainPanel(
textOutput("text1"),
plotOutput("graph")
)
)
server <- function(input, output) {
norm<-reactive({
set.seed(6)
rnorm(input$n,mean=input$mean,sd=input$sd)
})
output$text1<-renderText({
paste("A random normal distrubution of",
input$n, "observations is generated with parameters mean",
input$mean,"and standart deviation", input$sd)
})
output$graph = renderPlot({
if(input$plots == "both") {
par(mfrow = c(1, 2))
}
if(is.element(input$plots, c("histogram", "both"))) {
req(norm())
hist(norm())
}
if(is.element(input$plots, c("qq", "both"))) {
req(norm())
qqnorm(norm(), pch = 1, frame = FALSE)
qqline(norm(), col = "steelblue", lwd = 2)
}
})
}
shinyApp(ui = ui, server = server)
If you want two rows instead of two columns, just change par(mfrow = c(1, 2)) to par(mfrow = c(2, 1)).
(I'm still getting the error on if too, but it doesn't seem to affect the functioning of the app, at least as far as the graphs are concerned. I'm not sure where it's coming from.)
I have an app currently where the input$sliderInputID only changes when the mouse is released. Is it possible to have these values change as the slider is being dragged?
a demo app:
library(shiny)
shinyApp(
server = function(input, output, session) {
d_mean <- reactive({
input$sliderInputID
})
output$plot <- renderPlot({
x <- rnorm(n=1000, mean=d_mean(), sd=1)
plot(density(x))
})
},
ui = fluidPage(
sliderInput("sliderInputID", "Mean:", min = -5, max = 5, value = 0, step= 0.1),
plotOutput("plot")
)
)
In this case, the plot should update as the slider is being dragged, not only when the mouse is released.
Edit:
There is a similar question here: R reactive histogram
However, I'm still interested whether another solution is available using only the shiny library, since that answer was posted in 2016.
The link you provide is the quickest and cleanest way to what you want. That package is definitely still viable -- if you're worried about it disappearing then fork it on GitHub and install from your repo:
# devtools::install_github("homerhanumat/shinyCustom")
library("shiny")
library("shinyCustom")
shinyApp(
server = function(input, output, session) {
output$plot <- renderPlot({
x <- rnorm(n = 1000, mean = input$sliderInputID, sd = 1)
plot(density(x))
})
},
ui = fluidPage(
useShinyCustom(slider_delay = "0"),
customSliderInput("sliderInputID", "Mean:", min = -5, max = 5, value = 0, step = 0.1),
plotOutput("plot")
)
)
I am trying to write a simple app in Shiny R.
I would like to have two inputs (x and y) and plot the relative scatter plot. The code is the following
library(shiny)
ui<-fluidPage(
headerPanel('Plot'),
sidebarPanel(
sliderInput(inputId = 'x',label='X', value = 1,min=1,max=3),
sliderInput(inputId = 'y',label='Y', value = 1,min=1,max=3)
),
mainPanel(
plotOutput('plot')
)
)
server<-function(input,output) {
x <- reactive({input$x})
y <- reactive({input$y})
output$plot <- renderPlot({plot(x,y)})
}
shinyApp(ui=ui, server=server)
The code produce an error,
cannot coerce type 'closure' to vector of type 'double'
How can I correct this?
Thank you very much
X and Y are functions so add () to them
output$plot <- renderPlot({plot(x(),y())})
You could use this server argument instead:
server <- function(input,output) {
output$plot <- renderPlot(plot(input$x,input$y))
}
input values are already reactive so there's no need to wrap them in reactive() function. Here's your shiny in a neater, working way:
library(shiny) {
ui<-fluidPage(
headerPanel('Plot'),
sidebarPanel(
sliderInput(inputId = 'x', label= 'X', value = 1, min= 1, max= 3),
sliderInput(inputId = 'y', label= 'Y', value = 1, min= 1, max= 3)
),
mainPanel(plotOutput('plot'))
server<-function(input, output) {
output$plot<- renderPlot({
plot(input$x, input$y)
})
}
shinyApp(ui= ui, server= server)
I have a randomly generated data.frame. The user can modify a slider to choose the number of points. Then I plot this data.frame.
I want to add a button than when clicked, it performs a modification in the previous randomly generated data.frame (but without regenerating the data.frame). The modification is a voronoid relaxation, and it should be performed once per each time the button is clicked and the graph generated.
Until now, I have not achieved anything similar...
ui.R
library(shiny)
# Define UI for application that draws a histogram
shinyUI(fluidPage(
# Application title
titlePanel("Map Generator:"),
# Sidebar with a slider input for the number of bins
sidebarLayout(
sidebarPanel(
p("Select the power p to generate 2^p points."),
sliderInput("NumPoints",
"Number of points:",
min = 1,
max = 10,
value = 9),
actionButton("GenPoints", "Generate"),
actionButton("LloydAlg", "Relaxe")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot",height = 700, width = "auto")
)
)
))
server.R
library(shiny)
library(deldir)
shinyServer(function(input, output) {
observeEvent(input$NumPoints,{
x = data.frame(X = runif(2^input$NumPoints,1,1E6),
Y = runif(2^input$NumPoints,1,1E6))
observeEvent(input$LloydAlg, {
x = tile.centroids(tile.list(deldir(x)))
})
output$distPlot <- renderPlot({
plot(x,pch = 20,asp=1,xlim=c(0,1E6),ylim = c(0,1E6))
})
})
})
Of course there is something that I must be doing wrong, but I am quite new into shiny I can't figure it out what I am doing wrong...
This should work (even though I am pretty sure this could be improved):
shinyServer(function(input, output) {
library(deldir)
data = data.frame(
X = runif(2^9, 1, 1E6),
Y = runif(2^9, 1, 1E6)
)
rv <- reactiveValues(x = data)
observeEvent(input$GenPoints, {
rv$x <- data.frame(
X = runif(2^input$NumPoints,1,1E6),
Y = runif(2^input$NumPoints,1,1E6)
)
})
observeEvent(input$LloydAlg, {
rv$x = tile.centroids(tile.list(deldir(rv$x)))
})
output$distPlot <- renderPlot({
plot(rv$x,pch = 20,asp=1,xlim=c(0,1E6),ylim = c(0,1E6))
})
})
So first I initialize the points to plot. I use runif(2^9, 1, 1E6) because the starting value of the sliderInput is 9 all the time.
I also removed the observeEvent from the sliderInput and moved it to the GenPoints actionButton.
I'm having difficult using reactive expression in Shiny Apps. I'm creating a pie chart from slider input. This all works fine, however, the labels overlap. To avoid this I would like the label "" when the input is zero. The difficulty is that I'm unable to embed a reactive expression within an if-then statement.
Here is an MWE...
File "ui.R"...
library(shiny)
shinyUI(fluidPage(
titlePanel("Exposure to English calculator"),
sidebarLayout(
sidebarPanel(
h3("Sleeping"),
sliderInput("sleep", "How long does your child sleep every day?",
min=0, max=15, value=0, step = 0.5),
h3("School"),
sliderInput("school", "How long does your child spend in school?",
min = 0, max = 50, value=0, step = 0.5)
),
mainPanel(
plotOutput("plot")
)
)
))
File server.R...
library(shiny)
values <- c(1,2)
# Define server logic for slider examples
shinyServer(function(input, output) {
total_sleep <- reactive({7*input$sleep})
pieLabels<-c("sleep", "school", "other")
if(total_sleep() == 0) {
pieLabels[1] <- ""
}
output$plot <- renderPlot({
pie(c(total_sleep(), input$school, 50),
labels = pieLabels,
col = c("deepskyblue", "orange"),
height = 1500
)
})
})
The compilation crashes due to the "if" expression even though I've put the brackets after it, to show that it is derived from a reactive expression.
Thanks in advance.
You can just put all your total_sleep code and conditional statement inside the renderPlot function:
library(shiny)
app <- shinyApp(
ui = shinyUI(fluidPage(
titlePanel("Exposure to English calculator"),
sidebarLayout(
sidebarPanel(
h3("Sleeping"),
sliderInput("sleep", "How long does your child sleep every day?",
min=0, max=15, value=0, step = 0.5),
h3("School"),
sliderInput("school", "How long does your child spend in school?",
min = 0, max = 50, value=0, step = 0.5)
),
mainPanel(
plotOutput("plot")
)
)
)),
server = shinyServer(function(input, output) {
output$plot <- renderPlot({
total_sleep <- 7*input$sleep
pieLabels<-c("sleep", "school", "other")
if(total_sleep == 0) {
pieLabels[1] <- ""
}
pie(c(total_sleep, input$school, 50),
labels = pieLabels,
col = c("deepskyblue", "orange")
)
})
}))
runApp(app)
Note that I removed the height from pie because that argument doesn't exist and that gives out a warning.