I'm trying to make my first shiny app, in which a number of values are taken in, a number of calculations are performed (which depend on both values in the input and those in the server function), and then the outputs plotted. However, I can either no plot at all in the output (as in the sample below), or can just get the 1:1 line and not my data to show up. I'm not entirely sure where to begin troubleshooting, but I think I have problems with both making the calculations and feeding them into the plot function here. If you have any pointers it would be greatly appreciated.
Here is a simplified version of my app:
library(shiny)
require(ggplot2)
ui<-fluidPage(
sidebarLayout(
sidebarPanel(
titlePanel("mytitle"),
sliderInput(inputId= "min", label="minratio", value=0, min=0, max=0.499),
sliderInput(inputId= "max", label="maxratio", value=1, min=0.5, max=1)
),
mainPanel(
textOutput("valoutput"),
plotOutput("distPlot",width="100%"))
)
)
server<-function(input, output){
BS = function(x) {
mini=x[1]; maxi=x[2]
ratio <-seq(from=mini,to=maxi, by=0.01)
total<-30*ratio+3
res = c(ratio,total)
}
data<-reactive({as.data.frame("mini"=as.numeric(input$min), "maxi"=as.numeric(input$max))})
output$valoutput <- renderText({BS(data())[1]})
output$distplot <- renderPlot({
d1=BS(data())[1]
d2=BS(data())[2]
ggplot()+geom_abline(intercept = 0, slope=1, colour="grey50")+geom_point(aes(x=d1, y=d2))
}, height = 350, width = 600)
}
shinyApp(ui=ui, server=server)
Thanks so much!
Your BS function is not correct. Change it with this one (with as.numeric). Otherwise x[1]/x[2] will be data.frames and will throw an error in seq(). Alternatively you could also use double brackets, like x[[1]].
BS = function(x) {
mini=x[1]; maxi=x[2]
ratio <-seq(from=as.numeric(mini),to=as.numeric(maxi), by=0.01)
total<-30*ratio+3
res = c(ratio,total)
}
and in your ui your plot output name is not correct. It should be distplot not distPlot.
And you dont need to call as.data.frame, just data.frame does the right job, as you want to create a data.frame and not convert an object.
data <- reactive({
data.frame("mini"=as.numeric(input$min),
"maxi"=as.numeric(input$max))
})
Related
In the below super-simple MWE code, I'm trying to make the plot reactive to user slider input 'periods'. I've tried various iterations of observeEvent with no luck. Can someone please help me make this reactive?
The plot is supposed to show endBal on the y-axis and periods on the x-axis.
Also, in the below line of MWE code, res <- Reduce(f,seq(periods),init=beginBal,accumulate=TRUE) is not picking up the value of periods from the slider input. Instead to make the MWE run for demo I have to manually define the periods variable in the "Define vectors" section at the top of the code (periods <- 5 for example). Any idea why this part isn't working?
library(shiny)
### Define vectors ##############################################################
beginBal <- 1000
yield_vector <- c(0.30,0.30,0.30,0.30,0.30,0.28,0.26,0.20,0.18,0.20)
npr_vector <- c(0.30,0.30,0.30,0.30,0.30,0.30,0.30,0.30,0.30,0.30)
mpr_vector <- c(0.20,0.20,0.20,0.20,0.20,0.20,0.20,0.20,0.20,0.20)
default_vector <- c(0.10,0.10,0.10,0.10,0.10,0.09,0.08,0.07,0.06,0.05)
### End define vectors ##########################################################
ui <- fluidPage(
sliderInput(inputId = "periods",
label = "Periods:",
min = 1,
max = 10,
value = 5),
plotOutput(outputId = "balancePlot")
) # close fluid page
server <- function(input,output){
### Generates data for plotting ###############################################
f <- function(x,y){x*(1+npr_vector[y]-mpr_vector[y]-default_vector[y]/12)}
res <- Reduce(f,seq(periods),init=beginBal,accumulate=TRUE)
b <- head(res,-1)
endBal <- res[-1]
### End data for plotting #####################################################
output$balancePlot <- renderPlot({plot(endBal)})
} # close server
shinyApp(ui = ui, server = server)
Try this
output$balancePlot <- renderPlot({
f <- function(x,y){x*(1+npr_vector[y]-mpr_vector[y]-default_vector[y]/12)}
res <- Reduce(f,seq(input$periods),init=beginBal,accumulate=TRUE)
b <- head(res,-1)
endBal <- res[-1]
plot(endBal)
})
kindly help. I'm new to programming and i'm a bit confused.
I need to take an upload of 5 -10 pictures and perform PCA from scratch on them. but my plot output for the second tab is not rendering for the prop table . ** ALL Images display well on the first tab**, the issue comes on the processes after. ill appreciate some clarity on how to use Rshiny, i feel like I'm missing something that's fundamental.
library(shiny)
library(EBImage)
#ui
ui <- fluidPage(
titlePanel("Eigenfaces"),
sidebarLayout(
sidebarPanel (
fileInput("images","Upload images", multiple = T, accept = c('image/png',"image/jpeg"))
),
mainPanel(
tabsetPanel(
tabPanel('Images for PCA', plotOutput("image")),
tabPanel('Matrix', plotOutput("matrix"))
)
)
))
server <- function(input, output) {
img <- reactive ({
f<- input$images
if(is.null(f))
return(NULL)
readImage(f$datapath)
})
output$image <- renderPlot({
req(img())
plot(img(), all = TRUE)
})
output$matrix <- renderPlot({
req(img())
image_matrix <-do.call('cbind',lapply(img(),as.numeric))
#covaraince matrix
im <-scale(image_matrix, center = TRUE)
images <- cov(im)
#eigen computation
eigen_comp<-eigen(images)
#eigen vectors
eigen_vec <-eigen_comp$vectors
#eigen values
eigen_values <-eigen_comp$values
#proportion of eigen values
y = round(prop.table(eigen_values),3)
plot(y, type ="b")
})
}
# Run the application
shinyApp(ui = ui, server = server)
Using the as.list function i was able to bring the images in and get the plots
matrices <- reactive ({
req(img)
if(is.null(img()))
return(NULL)
f<- input$images
faces <- as.list(f$datapath)
image_list= lapply(faces,readImage)
image_matrix <-do.call('cbind',lapply(image_list,as.numeric))
y <-scale(image_matrix, center= TRUE)
})
faces for PCA
Variance plot
I want to draw a Plotly graph in the Shiny App in R. I want the the functionality in such a way that I want to plot a certain number of points (say 20) in a loop.
This is my code for the Server.R :-
xAxis = vector("numeric", as.numeric(input$Generations))
yAxis = vector("numeric", as.numeric(input$Generations))
graphDF = data.frame(cbind(xAxis, yAxis))
for(i in 1 : 5)
{ output$GA = renderPlotly({
print(graphDF) # Testing
graphDF$yAxis[i] = i
graphDF$xAxis[i] = i
print(graphDF) # Testing
# Plotly functionality
p <- plot_ly(graphDF, x = graphDF$xAxis, y = graphDF$yAxis)
})
}
Any help would be most appreciated.
Kind Regards
This was more complicated than it looked. It looks like you want to iterate and create a series of plotly graphs, changing the data values as you go along.
Because the Generations slider re-initializes the vector to a new length,
and each iteration changes the state of the data being plotted, you can't just cascade reactive functions. Storing the state in a reactiveValues is a good way to handle this.
The major changes were as follows:
Added a reactiveValues to store xAxis and yAxis
Added an observeEvent to reinitialize those values when its value change
Added an "Iteration range" slider to drive the iteration (easier than a reactive timer). Note that it has an animate parameter that (probably) creates a reactive timer on its own.
Modified the plotly call to make it more conventional and avoid warnings.
The code:
library(shiny)
library(plotly)
u <- fluidPage(
titlePanel("Iterations of a plotly graph"),
sidebarLayout(
sidebarPanel(
sliderInput("Generations","Number of Generations:",
min = 1, max = 50, value = 20),
sliderInput("iter", "Iteration range:",
value = 1, min = 1, max = 1000, step = 1,
animate=animationOptions(interval=800, loop=T)),
p("To start click on the blue arrowhead")
),
mainPanel(
plotlyOutput("GA")
)
))
s <- shinyServer(function(input,output){
rv <- reactiveValues(xAxis=NULL,yAxis=NULL)
observeEvent(input$Generations,{
rv$xAxis=vector("numeric", as.numeric(input$Generations))
rv$yAxis=vector("numeric", as.numeric(input$Generations))
})
output$GA = renderPlotly({
rv$yAxis[input$iter] <- input$iter
rv$xAxis[input$iter] <- input$iter
gdf <- data.frame(xAxis=rv$xAxis, yAxis=rv$yAxis)
plot_ly(gdf, x = ~xAxis, y = ~yAxis, type="scatter",mode="markers")
})
})
shinyApp(u,s)
Because it is dynamic, you have to run it to see how it really works, but here is a screen shot after several iterations:
I am trying to create numeric boxes for all column names in a data set. I have written below code but this displays a blank page. Not sure what the error is. Any suggestions?
library(shiny)
library(readr)
shinyApp(
ui <- fluidPage(
uiOutput("TestColumns")
),
server <- function(input, output) {
data_set <- read.csv("Data/170210_Flat_File.csv")
output$TestColumns <- renderUI({
for(i in names(data_set)){
numericInput(i, i,30)
}}
)})
First off, when you ask questions you should ALWAYS post a minimal reproducible example. That is basically something that we can run to replicate the issue you are having so that it is much easier for us to help you. This way we don't have to go about using different data, trying to figure out exactly what your error is. See this link for a good intro: How to make a great R reproducible example?
Next to your question - since you didn't explicitly post an error you were seeing or explicitly state what your issue was I'm going to go ahead and assume that your issue is that you don't see any UI's popping up when you run your Shiny App (this is what I got when I tried running your code with different sample data).
The reason you aren't seeing anything is because you aren't returning any objects from your for loop. If you really wanted to do a for loop you would have to loop through, store everything in a list, then return that list. Note that I had to use R's built in data because you didn't provide any. Something like this would work:
shinyApp(
ui <- fluidPage(
#numericInput("test","test",30),
uiOutput("TestColumns")
),
server <- function(input, output) {
data_set <- mtcars
output$TestColumns <- renderUI({
L<-vector("list",length(names(data_set)))
for(i in names(data_set)){
L[[i]]<-numericInput(i, i,30)
}
return(L)
})})
This should give you your desired result. However, the above is unnecessarily complicated. I suggest you use an lapply instead. Something like this is much better in my opinion:
shinyApp(
ui <- fluidPage(
#numericInput("test","test",30),
uiOutput("TestColumns")
),
server <- function(input, output) {
data_set <- mtcars
output$TestColumns <- renderUI({
lapply(names(data_set),function(x){numericInput(x,x,30)})
})})
ui <- bootstrapPage(
fluidRow(
column(4,offset = 2,
tags$h4("numeric inputs"),
uiOutput('mtcars_numerics') # These will be all the numeric inputs for mtcars
),
column(6,
tags$h4("current input values"),
verbatimTextOutput('show_vals') # This will show the current value and id of the inputs
)
)
)
server <- function(input, output, session){
# creates the output UI elements in the loop
output$mtcars_numerics <- renderUI({
tagList(lapply(colnames(mtcars), function(i){ # must use `tagList` `
column(3,
numericInput(
inputId = sprintf("mt_col_%s",i), # Set the id to the column name
label = toupper(i), # Label is upper case of the col name
min = min(mtcars[[i]]), # min value is the minimum of the column
max = max(mtcars[[i]]), # max is the max of the column
value = mtcars[[i]][[1]] # first value set to the first row of the column
))
})
)
})
# So we can see the values and ids in the ui for testing
output$show_vals <- renderPrint({
all_inputs <- names(session$input)
input_vals <- plyr::ldply(all_inputs, function(i){
data.frame(input_name = i, input_value = input[[i]],stringsAsFactors = FALSE)
})
input_vals
})
}
shinyApp(ui, server)
Results in:
I am trying to automate the interaction of a Shiny app so it displays a series of results while incrementing through a predetermined range of inputs, without having to repetitiously count and change input values. This automation will provide a systematic view of a set of inputs, such as displays of refreshed price charts for selected stocks, or plots of current performance indicators for real-time processes that are being monitored.
This is similar to question [Update graph/plot with fixed interval of time] (Update graph/plot with fixed interval of time) which runs a loop with a timer. Extending that approach, my objective is to:
a) Automatically set the invalidateLater pause high (1 hour) to effectively stop the cycle after a fixed (5) set of displays, pending new user input to restart it.
b) [When I can do that, I will add a counter-based control to cycle through a set of input$obs before it stops. For simplicity, that step, which has the same error and presumably same solution, is omitted here.]
Using the above referenced toy example, the following script does repeatedly cycle through its 5 displays, but it yields this error rather than changing the pause interval.
Listening on port 8100
Error in hist.default(dist, main = paste("Last Histogram count =", as.numeric(updater()), :
'x' must be numeric
as.numeric(autoControl())
Error: could not find function "autoControl"
I can not find the reactive conductor, reactiveValues or other methods that this task requires. Thank you for your help.
library(shiny)
updates <- 0
updater <- function(){ updates + 1 }
runApp(list(
ui = pageWithSidebar(
headerPanel("Hello Shiny!"),
sidebarPanel(
sliderInput("obs",
"Number of observations:",
min = 1,
max = 1000,
value = 50)
,
selectInput(inputId = "secPause",
label = "Seconds between displays:",
choices = c(1, 2, 3, 60*60),
selected = 2)
),
mainPanel(
plotOutput("distPlot")
)
),
server =function(input, output, session) {
updateTracker <- reactive( {
invalidateLater(as.numeric(input$secPause) * 1000, session)
updates <<- as.numeric(updater())
})
autoControl <- reactive( {
if(updateTracker() <= 5)
secPause <<- input$secPause
else
secPause <<- 60*60
return(secPause)
})
output$distPlot <- renderPlot( {
if(updateTracker() <= 5) {
# generate an rnorm distribution and plot it
dist <- rnorm(input$obs)
hist(dist, main = paste("Histogram count =" , updateTracker()))
}
else {
updates <<- 0
hist(dist, main = paste("Last Histogram count =",
as.numeric(updater()), "with secPause =",
as.numeric(autoControl())))
}
})
}
))
You are getting the error because the hist distribution is defined inside the if clause, but you are using it (after 5 intervals) inside the else clause, where it is not defined. That's why it works for the first 5 intervals.
if(updateTracker() <= 5) {
# generate an rnorm distribution and plot it
dist <- rnorm(input$obs)
hist(dist, main = paste("Histogram count =" , updateTracker()))
}
else {
updates <<- 0
hist(dist, main = paste("Last Histogram count =",
as.numeric(updater()), "with secPause =",
as.numeric(autoControl())))
}
After I moved the dist to before the if condition, I got your cycling to work. (I also split your code into UI.R and server.R to make it more manageable.) Not pasting here since it is essentially the same code, but you can find the working version of code in this gist.