I want to use the validate function in Rshiny.
output$one <- renderTable({
isolate({
Loadprob <- input$prob1
prob <- read.xls(Loadprob$datapath)
validate(need(ncol(prob)==13, "Error"))
But the function validate does not returns the "Error" message and I don't know why.
Thank you!
I created a reproducible example of your code. Please for further questions, try to do it yourself. This makes it a lot easier to find and solve the problem.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("prob1", label = "Excel File", multiple = F)
),
mainPanel(
tableOutput("one")
)
)
)
# Server logic
server <- function(input, output) {
output$one <- renderTable({
req(input$prob1)
Loadprob <- input$prob1
prob <- read.csv(Loadprob$datapath, header = T, sep = ";")
## prob <- read.xls(Loadprob$datapath)
validate(need(ncol(prob)==13, "Error"))
prob
})
}
shinyApp(ui, server)
I used read.csv instead of read.xls, as i could not install the xlsx-package, but that shouldnt be the issue.
You also have to include a req() at the beginning of the renderTable function, as it should only be executed, when a file is uploaded.
At the end, you have to tell which variable should be plotted as a table, which in this case is "prob".
Related
i have a question regarding Shiny and the usage of Data frames.
I think i understood that i need to create isolated or reactive environmentes to interact with, but if i try to work with the Dataframe i get an error message:
Error in pfData: konnte Funktion "pfData" nicht finden
i tried to manipulate the dataframe by this code:
server <- function(input, output) {
observeEvent(input$go,
{
pf_name <- reactive({input$pfID})
pf_date <- reactive({input$pfDate})
if (pf_name()!="please select a PF") {
pfData <- reactive(read.csv(file =paste(pf_name(),".csv",sep=""),sep=";",dec=","))
MDur <- pfData()[1,15]
pfData <- pfData()[3:nrow(pfData()),]
Total = sum(pfData()$Eco.Exp...Value.long)
}
})
}
If i manipulate my Dataframe in the console it works just fine:
pfData <- pfData[3:nrow(pfData),]
Total = sum(pfData$Eco.Exp...Value.long)
Assets = sum(as.numeric(gsub(",",".",gsub(".","",pfData$Value,fixed=TRUE),fixed=TRUE)))
pfData$Exposure <- with(pfData, Eco.Exp...Value.long /Total)
can you help me?
Edit:
library(shiny)
ui <- fluidPage(
fluidRow(
column(6, offset =3,
wellPanel(
"Choose Mandate and Date",
fluidRow(
column(4,selectInput("pfID",label = "",
choices = list("please select a PF","GF25",
"FPM"),
selected = "please select a PF") ),
column(4, dateInput("pfDate",label="",value = Sys.Date()) ),
column(2, actionButton("go","Submit")),column(2,textOutput("selected_var"))
)
)
)
)
)
# Define server logic ----
server <- function(input, output) {
pfDataReactive <- reactive({
input$go
if (pf_name()!="please select a PF") {
pfData <- read.csv(file =paste(pf_name(),".csv",sep=""),sep=";",dec=",")
MDur <- pfData[1,15]
pfData <- pfData[3:nrow(pfData),]
Total = sum(pfData$Eco.Exp...Value.long)
Assets = sum(as.numeric(gsub(",",".",gsub(".","",pfData$Value,fixed=TRUE),fixed=TRUE)))
pfData$Exposure <- with(pfData, Eco.Exp...Value.long /Total)
pfData
output$selected_var <- renderText({paste(MDur)})
}
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
Thank you
Stefan
Without a working example, it's imposible to be sure what you're trying to do, but it sounds like you need a reactive rather than using observeEvent.
Try something like
pfDataReactive <- reactive({
input$go
pfData <- read.csv(file =paste(pf_name(),".csv",sep=""),sep=";",dec=",")
Total = sum(pfData$Eco.Exp...Value.long)
Assets = sum(as.numeric(gsub(",",".",gsub(".","",pfData$Value,fixed=TRUE),fixed=TRUE)))
pfData$Exposure <- with(pfData, Eco.Exp...Value.long /Total)
pfData
})
And then use pfDataReactive() in your Shiny app's server function wherever you would refer to pfData in your console code.
The standalone reference to input$go ensures the reactive will update whenever input$go changes/is clicked/etc.
Update
There are still significant issues with your code. You've added an assignment to an output object as the last line of the reactive I gave you, so the reactive always returns NULL. That's not helpful and is one of the reasons why it "doesn't active at all"...
Second, you test for the existence of an reactive/function called pf_name when the relevant input object appears to be input$pfID. That's another reason why the reactive is never updated.
Note the change to the definition of input$pfID that I've made to improve the readability of the pfDataReactive object. (This change also probably means that you can do away with input$go entirely.)
As you say, I don't have access to your csv file, so I can't test your code completely. I've modified the body of the pfDataReactive to simply return the mtcars dataset as a string. I've also edited the code I've commented out to hopefully run correctly when you use it with the real csv file.
This code appears to give the behaviour you want,. Though, if I may make a subjective comment, I think the layout of your GUI is appaling. ;=)
library(shiny)
ui <- fluidPage(
fluidRow(
column(6, offset =3,
wellPanel(
"Choose Mandate and Date",
fluidRow(
column(4,selectInput("pfID",label = "",
# Modified to that "Pleaseselect a PF" returns NULL
choices = list("please select a PF"="","GF25", "FPM"),
selected = "please select a PF") ),
column(4, dateInput("pfDate",label="",value = Sys.Date()) ),
column(2, actionButton("go","Submit")),column(2,textOutput("selected_var"))
)
)
)
)
)
# Define server logic ----
server <- function(input, output) {
pfDataReactive <- reactive({
# Don't do anything until we have a PF csv file
req(input$pfID)
input$go
# Note the change to the creation of the file name
# pfData <- read.csv(file =paste(input$pfID,".csv",sep=""),sep=";",dec=",")
# pfData <- pfData[3:nrow(pfData),]
# Total = sum(pfData$Eco.Exp...Value.long)
# Assets = sum(as.numeric(gsub(",",".",gsub(".","",pfData$Value,fixed=TRUE),fixed=TRUE)))
# pfData$Exposure <- with(pfData, Eco.Exp...Value.long /Total)
# MDur <- pfData[1,15]
# If you want to print MDur in the selected_var output, MDur should be the retrun value from this reactive
# MDur
mtcars
})
output$selected_var <- renderText({
print("Yep!")
as.character(pfDataReactive())
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
Next time, please, please, make more effort to provide a MWE. This post may help.
This is a good introduction to Shiny.
I tried to create a shinyApp with seq() function within the Apps.
header <- dashboardHeader(title = 'Testing' ,titleWidth = 300)
sidebar <- dashboardSidebar(uiOutput("sidebarpanel"), width = 300)
body <- dashboardBody(uiOutput("body"))
uix <- dashboardPage(header, sidebar, body)
serverx <- function(input, output, session){
output$sidebarpanel <- renderUI({
div(
sidebarMenu(id="tabs",
menuItem("Tes 1", tabName = "tes1", icon = icon("dashboard"), selected = TRUE)
)
)
})
output$body <- renderUI({
tabItems(tabItem(tabName = "tes1",
fluidRow(column(2, textInput("s1", "From :", value = 1))
,column(2, textInput("s2", "To", value = 7))
),
textOutput("result")
)
)
})
segment_low <- reactiveValues(ba=NULL)
segment_high <- reactiveValues(ba=NULL)
results <- reactiveValues(ba=NULL)
toListen <- reactive({
list(input$s1, input$s2)
})
observeEvent(toListen(),{
segment_low$ba <- input$s1 %>% as.numeric()
segment_high$ba <- input$s2 %>% as.numeric()
})
observe({
results$ba <- seq(segment_low$ba,segment_high$ba, 1)
})
output$result <- renderText({
results$ba
})
}
shinyApp(uix, serverx)
In that syntax, I would create a variable called results$ba because I want to escalate that value in the next time. But it turns out an error :
Warning: Error in seq.default: 'from' must be of length 1
[No stack trace available]
Could someone help me how to solve this problem? Since this error just happened if I put the reactiveValues to the seq() function, while I input a static input, for example seq(2,5,1) it will not return a error. And I already put the initial value for each input in textInput() function also.
Kindle need your help, developers!
Many Thanks.
The issue is that you're rendering the s1 and s2 inputs server-side. Because of this, the server at the beginning renders them as NULL, and your seq function errors when it gets the NULL value.
The simplest thing to do is to add a req function to prevent your code from evaluating unless it's getting some non-NULL values.
observe({
req(segment_low$ba, segment_high$ba)
results$ba <- seq(segment_low$ba,segment_high$ba, 1)
})
Basically, since you're using observe, which is very eager, you are telling the seq function to evaluate right away. By using the req function, you're stopping the chain of evaluation from happening unless the segment_low$ba and segment_high$ba have non-NULL values.
I'm trying to create a dashboard using shiny in R, but I'm facing some little problems
I have:
db is my data.frame with:
db$domain:chr,
db$date:chr,
db$value:num.
So I've created:
db_4 <- reactive({ subset(db,db$domain %in% input$domain &
db$date<=input$daterange[2] & db$date>=input$daterange[1]})
the inputs are:
input$domain: selectinput with multiple choices,
input$date: daterangeinput.
I'm trying to create a table that gives me the sum of the db$value, aggregated by db$date. I've tried something like:
output$table2 <- rendertable ({aggregate(db_4()["value"], by=list(db_4()["date"]), sum) })
but I get always an empty table.
Can anybody help me in solving this little issue?
Thx a lot
I would highly recommend you to read this article about debugging.
In Shiny you can use the browser() function within both reactive and render functions. It should help you locate the problem (i.e.: data has the expected structure)
It seems the problem is with the aggregate function: db_4()["date"] returns a data.frame, where you need a vector.
Solution:
library(shiny)
db <- data.frame(
domain = letters[1:3],
date = seq(
from = as.Date("2019-01-01"),
to = as.Date("2019-06-01"),
by = "1 months"
),
value = runif(12)
)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("domain", "Domain", choices = unique(db$domain)),
dateRangeInput("daterange", "Date",
min = min(db$date), max = max(db$date),
start = min(db$date), end = max(db$date))
),
mainPanel(
tableOutput("table2")
)
)
)
server <- function(input, output, session) {
db_4 <- reactive( {
subset(db,
db$domain %in% input$domain &
db$date<=input$daterange[2] &
db$date>=input$daterange[1]
)
})
output$table2 <- renderTable( {
req(db_4()) # Don't render table when db_4() is NULL
# Uncomment next line to check if everything goes as expected
#browser()
aggregate(
data.frame(value = db_4()$value),
by=list(date = as.factor(db_4()$date)),
sum
)
})
}
shinyApp(ui, server)
Also I would highly recommend sharing the code of your minimal example including some dummy data, so that it can be copy-pasted in an instant. It would increase the chances of someone answering.
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 getting errors as "Warning: Error in grepl: invalid 'pattern' argument" and "Error in [: incorrect number of dimensions" (in UI) while executing shiny code. please help. below is the snippet of the code. I am getting error when I am un-commenting last line
library(MASS)
library(shinythemes)
library(shiny)
library(ggplot2)
mass.tmp <- data(package = "MASS")[3]
mass.datasets <- as.vector(mass.tmp$results[,3])
ui <- fluidPage(
theme = shinytheme("superhero"),
titlePanel("Linear Regression Modelling"),
sidebarLayout(
sidebarPanel(
selectInput("dsname", "Dataset:",choices = c(mass.datasets)),
uiOutput("y_axis"),
uiOutput("x_axis")
) ,
mainPanel(
tags$br(),
tags$br(),
"R-squared:",
tags$span(tags$b(textOutput("rsquared")),style="color:blue")
)
)
)
server <- function(input, output) {
output$x_axis <- renderUI({
col_opts <- get(input$dsname)
selectInput("x_axis2", "Independent Variable:", choices = c(names(col_opts)))
})
cols2 <- reactive({
col_opts2 <- get(input$dsname)
#names(col_opts2)[!grepl(input$x_axis2, names(col_opts2))]
})
output$y_axis <- renderUI({
selectInput("y_axis2", "Dependent Variable:", choices = c(names(cols2())))
})
model <- reactive({
#lm(input$dsname[,names(input$dsname) %in% input$y_axis2] ~ input$dsname[,names(input$dsname) %in% input$x_axis2])
#tmp <- paste(input$y_axis2,"~",input$x_axis2,sep = " ")
lm( input$y_axis2 ~ input$x_axis2 , data = input$dsname )
})
model_summary <- reactive({summary(model())})
output$rsquared <- renderText({ model_summary()$r.squared })
}
shinyApp(ui = ui, server = server)
Yes thats better.
There a multiple errors:
We shouldnt debug it all for you, but here are quite some pointers.
That should help you to find them all.
1)
You are using: input$x_axis and input$y_axis but defined it with a "2" at the end. So adapt that.
2)
You should define:
cols2 <- reactive({
col_opts2 <- get(input$dsname)
names(col_opts2)[!grepl(input$x_axis2, names(col_opts2))]
})
outside the renderUI function.
3) Moreover, there seems to be something wrong with this snippet:
names(col_opts2)[!grepl(input$x_axis2, names(col_opts2))]
Finally, I would check if you produce NULLS and prohibit that by !is.null().
Edit: Question update:
You tried to build the lm()formula by strings, which you can test outside of shiny: Will not work.
You should use the formula() function and come up with somethin like:
lm(formula(paste(input$y_axis2, input$x_axis2, sep =" ~ ")), data = get(input$dsname))