Goal: Make an image change size in response to moving a slider in Shiny (RStudio). Think zoom-in-zoom-out effect.
Problem: There's an error saying "Error in basename(imageinfo$src) : a character vector argument expected". I can't find anything that directly answers the question and I'm not sure what else to try. Is it just a problem with how sliderInput is used as input$slider in server.R?
My current progress: My rational was to set up the slider in the ui.R file and then have the width of the image be the input in the server.R file.
The ui.R part:
shinyUI(fluidPage(
titlePanel("Nancy's Brainstorming"),
sidebarLayout(
sidebarPanel(
h3(
strong("What is this?", style = "font-si24pt")),
p("This is a pilot project."),
sliderInput("slider",
label = "",
min = 100,
max = 300,
value = 200),
imageOutput("logo", width = 200)
)
)
))
The server.R part:
shinyServer(function(input, output) {
output$logo = renderImage({
img(src = "mylogo.png", width = input$slider)
})
})
Additional information: The image shows up just fine by itself when I use img(src = "mylogo.png", width = 200). Also, I'm doing this just to get a better feel for building Shiny apps.
img(src = "mylogo.png", width = input$slider) is just returning html. You can use renderUI instead of renderImage.
library(shiny)
runApp(
list(ui = fluidPage(
titlePanel("Nancy's Brainstorming"),
sidebarLayout(
sidebarPanel(
h3(
strong("What is this?", style = "font-si24pt")),
p("This is a pilot project."),
sliderInput("slider", label = "", min = 100, max = 300, value = 200),
uiOutput('logo')
),
mainPanel(
plotOutput("distPlot")
)
)
),
server = function(input, output, session) {
output$logo <- renderUI({
img(src = "http://i.stack.imgur.com/mTqXa.png", width = as.integer(input$slider))
})
}
)
)
Related
I am trying to keep each number within its respective knobInput, regardless of zoom status or screen size. However, after zooming 120% or reducing the screen size, the number pops outside of its relative position.
library(shiny)
ui <- fluidPage(fluidRow(
column(2, uiOutput("example_1")),
column(2, uiOutput("example_2")),
column(2, uiOutput("example_3")),
column(2, uiOutput("example_4")),
column(2, uiOutput("example_5")),
column(2, uiOutput("example_6"))
)
)
server <- function(input, output, session) {
output$example_1 = output$example_2 = output$example_3 = output$example_4 = output$example_5 = output$example_6 = renderUI(knobInput(
inputId = "example_knob",
label = NULL,
value = 10,
fontSize = "2em"
))
}
shinyApp(ui, server)
Grateful for any advice as to how I could achieve this.
So ... The problem here is that you are not filling the horizontal space of your fluidrow which is 12 with your columns. Setting the columnwidth to 4 makes it work:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(fluidRow(
column(4, uiOutput("example_1")),
column(4, uiOutput("example_2")),
column(4, uiOutput("example_3"))
)
)
server <- function(input, output, session) {
output$example_1 = output$example_2 = output$example_3 = renderUI(knobInput(
inputId = "example_knob",
label = NULL,
value = 10,
fontSize = "2em"
))
}
shinyApp(ui, server)
I've come across some open issues when looking for a way to make a vertical slider in R Shiny apps, to put next to one of my plots so that the user can "move a horizontal line" in the plot with a slider that follows the same range as the plot's y axis.
I managed to make the slider turn vertical, but it still wants the mouse to be dragged horizontal. Anyone a clue how to attack this with css to rotate the drag action?
library(shiny)
ui <- fluidPage(
fluidRow(
column(3,
sliderInput(inputId = 'myslider1', label = 'Change vertical', min = -5, max = 6.3, step = 0.1, value = -6)
),
column(3,
sliderInput(inputId = 'myslider2', label = 'Change horizontal', min = -5, max = 6.3, step = 0.1, value = 0)
), style = "margin-top:200px"
),
tags$style(HTML(".js-irs-0 { transform: rotateZ(270deg)}")),
tags$style(HTML(".js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {background: yellow}"))
)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
There is this function noUiSliderInput() from the shinyWidgets package that does what you need.
See example below:
if (interactive()) {
### examples ----
# see ?demoNoUiSlider
demoNoUiSlider("more")
### basic usage ----
library( shiny )
library( shinyWidgets )
ui <- fluidPage(
tags$br(),
noUiSliderInput(
inputId = "noui1",
min = 0, max = 100,
value = 20
),
verbatimTextOutput(outputId = "res1"),
tags$br(),
noUiSliderInput(
inputId = "noui2", label = "Slider vertical:",
min = 0, max = 1000, step = 50,
value = c(100, 400), margin = 100,
orientation = "vertical",
width = "100px", height = "300px"
),
verbatimTextOutput(outputId = "res2")
)
server <- function(input, output, session) {
output$res1 <- renderPrint(input$noui1)
output$res2 <- renderPrint(input$noui2)
}
shinyApp(ui, server)
}
I have a shiny app where i want to hide or show some elements based on user input. This i tried to do by using conditionalPanel in shiny. However, it works only after pressing the submit button. I want to hide or show the textInput element without pressing the submit button. Below is an example what I tried.
UI.R
library(shiny)
shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
column(3, wellPanel(
sliderInput("n", "N:", min = 10, max = 1000, value = 200,
step = 10),
checkboxInput("checkbox", label = "Message", value = FALSE),
conditionalPanel(
condition = "input.checkbox == true",
textInput("text", "Text:", "text here")),
submitButton("Submit")
)),
column(6,
plotOutput("plot1", width = 400, height = 300),
verbatimTextOutput("text")
)
)
))
Server.R
shinyServer(function(input, output) {
output$plot1 <- renderPlot({
hist(rnorm(input$n))
})
output$text <- renderText({
paste("Input text is:", input$text)
})
})
I want to show the textInput as soon as user checks the checkbox and hide it on uncheck without any dependency on submit button.
You can try
UI:
library(shiny)
shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
column(3, wellPanel(
sliderInput("n", "N:", min = 10, max = 1000, value = 200,
step = 10),
checkboxInput("checkbox_1", label = "Message", value = FALSE),
uiOutput('test')
,actionButton("Submit",label ="Submit" )
)),
column(6,
plotOutput("plot1", width = 400, height = 300),
verbatimTextOutput("text")
)
)
))
server:
shinyServer(function(input, output,session) {
output$test=renderUI({
if(input$checkbox_1==T){
list(textInput("text", "Text:", "text here"),
numericInput("num","num",0), numericInput("num1","num1",0))}
})
observeEvent(input$Submit,{
output$plot1 <- renderPlot({
hist(rnorm(isolate(input$n)))
})
output$text <- renderText({
paste("Input text is:", isolate(input$text))
})
})
})
I'm trying to access an input field in mainPanel from the sidebarPanel, but I couldn't succeed.
Code:
shinyUI(pageWithSidebar{
sidebarPanel(
sliderInput("x", "X", min = 10, max = 100, value = 50)
),
mainPanel(
#this is where I wanna use the input from the sliderInput
#I tried input.x, input$x, paste(input.x)
)
})
Where seems to be the problem? Or isn't possible to use the input from the sidebarPanel in the mainPanel?
You can only use the inputs in the server side.
For example :
library(shiny)
runApp(list(
ui = pageWithSidebar(
headerPanel("test"),
sidebarPanel(
sliderInput("x", "X", min = 10, max = 100, value = 50)
),
mainPanel(
verbatimTextOutput("value")
)
),
server = function(input, output, session) {
output$value <- renderPrint({
input$x
})
}
))
EDIT ::
Dynamically set the dimensions of the plot.
Use renderUi to render a plot output using the values of your inputs.
library(shiny)
runApp(list(
ui = pageWithSidebar(
headerPanel("Test"),
sidebarPanel(
sliderInput("width", "Plot Width (%)", min = 0, max = 100, value = 100),
sliderInput("height", "Plot Height (px)", min = 0, max = 400, value = 400)
),
mainPanel(
uiOutput("ui")
)
),
server = function(input, output, session) {
output$ui <- renderUI({
plotOutput("plot", width = paste0(input$width, "%"), height = paste0(input$height, "px"))
})
output$plot <- renderPlot({
plot(1:10)
})
}
))
I've got an application with a large number of parameters. Each parameters has lots of granularity which make finding the desired one a pain. This causes the reactive portion to constantly calculate which slows things down. I added a submitButton which solved the above problem but then experience another problem in turn.
Below is a simple replication of the framework I build. The parameter input takes in a number from 1 to 1000, which indicates the sample to which I want. What I would like to do is be able to do above but also be able to resample with the same set of parameters. What is happening now after adding the submit button is that it renders the resample button inoperable unless I click resample first AND then update button.
Any ideas of making them both working separately?
shinyServer(function(input, output) {
getY<-reactive({
a<-input$goButton
x<-rnorm(input$num)
return(x)
})
output$temp <-renderPlot({
plot(getY())
}, height = 400, width = 400)
})
shinyUI(pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
sliderInput("num",
"Number of Samples",
min = 2,
max = 1000,
value = 100),
actionButton("goButton", "Resample"),
submitButton("Update View")
),
mainPanel(
tabsetPanel(
tabPanel("Heatmap",
plotOutput("temp")
),
tabPanel("About"),
id="tabs"
)#tabsetPanel
)#mainPane;
))
EDIT based on Joe's Answer:
shinyServer(function(input, output) {
getY<-reactive({
isolate({a<-input$goButton
x<-rnorm(input$num)
return(x)})
})
output$temp <-renderPlot({
b<-input$goButton1
plot(getY())
}, height = 400, width = 400)
})
shinyUI(pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
sliderInput("num",
"Number of Samples",
min = 2,
max = 1000,
value = 100),
actionButton("goButton", "Resample"),
actionButton("goButton1","Update View")
),
mainPanel(
tabsetPanel(
tabPanel("Heatmap",
plotOutput("temp")
),
tabPanel("About"),
id="tabs"
)#tabsetPanel
)#mainPane;
))
The answer was given by Joe Cheng in a comment above, but seeing that the OP had difficulty understanding it, I write it out explicitly below, for the record:
# ui.R
library("shiny")
shinyUI(
pageWithSidebar(
headerPanel("Example")
,
sidebarPanel(
sliderInput("N", "Number of Samples", min = 2, max = 1000, value = 100)
,
actionButton("action", "Resample")
)
,
mainPanel(
tabsetPanel(
tabPanel("Plot", plotOutput("plotSample"))
,
id = "tabs1"
)
)
)
)
# server.R
library("shiny")
shinyServer(
function(input, output, session) {
Data <- reactive({
input$action
isolate({
return(rnorm(input$N))
return(x)
})
})
output$plotSample <-renderPlot({
plot(Data())
} , height = 400, width = 400
)
})
Note that having input$action inside reactive(), where "action" is the actionButton's inputID, is enough to trigger a new rendering of the plot. So you need only one actionButton.
change getY so that all but the first line is wrapped in isolate({ ... })
change submitButton to actionButton
add a line inside of renderPlot to read the new actionButton