I am trying to render a Data table in R shiny on selected inputs but getting an error:-
output$reconOutput <- renderUI({
reconOutput <- sort(unique(as.vector(my_data$ReconIdName)), decreasing = FALSE)
reconOutput <- append(reconOutput, "All", after = 0)
selectizeInput("reconchoose", "Recon:", reconOutput)
})
output$statusOutput <- renderUI({
statusOutput <- sort(unique(as.vector(my_data$Status)), decreasing = FALSE)
statusOutput <- append(statusOutput, "All", 0)
selectizeInput("statuschoose", "Status:", statusOutput)
})
output$issuesbyReconName<- renderDataTable(
data <- reactive({
req(input$reconchoose)
req(input$statuschoose)
if(input$reconchoose == "All") {
filt1 <- quote(recon != "#?><")
} else {
filt1 <- quote(recon == input$reconchoose)
}
if (input$statuschoose == "All") {
filt2 <- quote(status != "#?><")
} else {
filt2 <- quote(status== input$statuschoose)
}
raw %>%
filter_(filt1) %>%
filter_(filt2)
})
)
Could you please guide me on this?
output$issuesbyReconName
1: shiny::runApp
Warning: Error in if: missing value where TRUE/FALSE needed
Is it related to any null value in columns that is creating a conflict in the code?
Can you share your input side code as well? It looks like it might be caused by there being no default value for some of the input objects, leading to the error.
Try either to set a default value for these objects or start the IF series with something like
if (is.na(input$reconchoose)) return("") else
Related
I have code like this
myfx <- reactive({
req(
isTruthy(input$value),
isTruthy(data1()) || isTruthy(data2())
)
...
if(exists(data2())) {
# do some stuff
}
## do this other stuff regardless
})
The if(exists()) piece is where I am stuck. Exists is not the right function here, nor does validate(need(data2())) work. How can I conditionally execute some code if one of the optional reactives (from a group where at least one is required) exists?
EDIT 1: To make explicit the problem, see the issue illustrated by the debug prints below:
myfx <- reactive({
req(
isTruthy(input$value),
isTruthy(data1()) || isTruthy(data2())
)
print("I am printed, and data2() has not been uploaded by user")
print(isTruthy(data2()))
print("I am never printed")
if(isTruthy(data2())) {
# do some stuff
}
## do this other stuff regardless
})
Edit 2: ok I see the reason. And I also see that I'm not observing the behavior in my first req() call because of short-circuiting (||). But now I'm stuck how to achieve the behavior I want. Bascially I don't calculate data2() until the user uploads something (use a req() here too). So that is where this is hanging. But if I remove the req() from the top of this, then I get errors due to trying to work on input that doesn't exist. See the definition for data2() below. How can I fix this?
data2 <- reactive({
req(input$data2)
read.csv(input$data2$datapath) %>%
as_tibble() %>%
return()
})
You can re-use isTruthy. Since it still returns true for 0 rows, you may want to add a check for non-zero row count:
myfx <- reactive({
req(
isTruthy(input$value),
isTruthy(data1()) || isTruthy(data2())
)
...
if (isTruthy(data2()) && nrow(data2()) > 0) {
# do some stuff
}
## do this other stuff regardless
})
Or you can capture the attempt in a try/tryCatch and react accordingly:
myfx <- reactive({
req(
isTruthy(input$value),
isTruthy(data1()) || isTruthy(data2())
)
...
res2 <- tryCatch({
# do some stuff with data2()
}, error = function(e) NULL)
## do this other stuff regardless
})
Ok, here is the final working solution.
myfx <- reactive({
req(
isTruthy(input$value),
isTruthy(data1()) || isTruthy(data2())
)
print("I am printed, and data2() has not been uploaded by user")
print(isTruthy(data2()))
print("I am never printed")
if(isTruthy(data2())) {
# do some stuff
}
## do this other stuff regardless
})
data2 <- reactive({
if(isTruthy(input$data2)) {
read.csv(input$data2$datapath) %>%
as_tibble() %>%
return()
}
})
raise an error if dat2 doesn't exit by checking number of rows
chk will become NULL if dat2 doens't exist
use chk in if statement to determine what to do
chk <- tryCatch({ nrow(dat2()) > 0}, error = function(e) NULL)
if(is.null(chk)){
dat1
} else{
cbind(dat1, dat2)
}
I am using the following code and I always get this subsettable error unless if I run the line
df <- read.csv("./world-happiness-report-cleaned.csv")
manually before running the app. What am I subsetting, and where am I wrong? I can't seem to find the error, and I'm super new to Shiny so I've never had to deal with this before. Thank you so much!!
This link is to a filebin that has the csv I used: https://filebin.net/wjctohctz1sxm16y
server.R
# Elit Jasmine Dogu, ejd5mm
# Project One DS 3002
library(dplyr)
library(countrycode)
library(shiny)
df <- read.csv("./world-happiness-report-cleaned.csv")
#saveRDS(df, "./df.RDS")
server <- function(input, output) {
#reading in the data and basic data cleaning
#df<- read.csv("world-happiness-report-cleaned.csv")
#df <<- readRDS("./df.RDS")
#df <- read.csv("./world-happiness-report-cleaned.csv")
# Filter data based on user selections
output$table <- DT::renderDataTable(DT::datatable({
data <- df %>%
filter(
if(input$year != "All") {
Year ==input$year
} else {TRUE}
) %>%
filter(
if(input$country != "All") {
Country ==input$country
} else {TRUE}
) %>%
filter(
if(input$continent != "All") {
Continent ==input$continent
} else {TRUE}
)
return(data)
}))
# Generate a summary of the dataset (on the left panel)
output$summary <- renderPrint({
data <- df %>%
filter(
if(input$year != "All") {
Year ==input$year
} else {TRUE}
) %>%
filter(
if(input$country != "All") {
Country ==input$country
} else {TRUE}
) %>%
filter(
if(input$continent != "All") {
Continent ==input$continent
} else {TRUE}
)
return(summary(data))
})
#Generate a function to show the number of rows w/ any given dataframe selection/restriction
rows = function() {
data <- df %>%
filter(
if(input$year != "All") {
Year ==input$year
} else {TRUE}
) %>%
filter(
if(input$country != "All") {
Country ==input$country
} else {TRUE}
) %>%
filter(
if(input$continent != "All") {
Continent ==input$continent
} else {TRUE}
)
return(nrow(data)) #returns number of rows of the data
}
#Generate a function to show the number of columns w/ any given dataframe selection/restriction
cols = function() {
data <- df %>%
filter(
if(input$year != "All") {
Year ==input$year
} else {TRUE}
) %>%
filter(
if(input$country != "All") {
Country ==input$country
} else {TRUE}
) %>%
filter(
if(input$continent != "All") {
Continent ==input$continent
} else {TRUE}
)
return(ncol(data)) #returns the number of columns of the data
}
#Using the functions created above
output$columns <- renderText({
paste("Number of Columns:" , cols() ) #text to display the number of columns
})
output$rows <- renderText({
paste("Number of Rows (Records):" , rows() ) #text to display the number of rows
})
output$data_ex <- renderText({
paste("Please see README.md file for information regarding the dataset.") #text to display where to find more information
})
# Downloadable csv of selected dataset
output$downloadData <- downloadHandler(
filename = function() {
selected <-c() #this assists with the name of the file
if (input$year != "All") {
selected <-c(selected, input$year)
}
if (input$country != "All") {
selected <-c(selected, input$country)
}
if (input$continent != "All") {
selected <-c(selected, input$continent)
}
if (length(selected) == 0) {
selected <- c("AllData")
}
paste0(paste(selected, collapse="-"), ".csv")
},
content = function(con) {
data <- df %>%
filter(
if(input$year != "All") {
Year ==input$year
} else {TRUE}
) %>%
filter(
if(input$country != "All") {
Country ==input$country
} else {TRUE}
) %>%
filter(
if(input$continent != "All") {
Continent ==input$continent
} else {TRUE}
)
write.csv(data, con, row.names = TRUE) #saves the filtered data
}
)
}
ui.R
# Elit Jasmine Dogu, ejd5mm
# Project One DS 3002
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
#text with project name and my information
titlePanel("World Happiness Report"),
tags$h3("DS 3002- Project One"),
tags$h4("Elit Dogu, ejd5mm 3rd Year UVA"),
# use a gradient in background, setting background color to blue
setBackgroundColor(
#https://rdrr.io/cran/shinyWidgets/man/setBackgroundColor.html used this website for help on background color
color = c("#F7FBFF", "#2171B5"),
gradient = "radial",
direction = c("top", "left")
),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Output: Header + summary of distribution ----
h4("Summary"),
verbatimTextOutput("summary"),
# Download button
downloadButton("downloadData", "Download")
),
# Create a new Row in the UI for selectInputs
# Main panel for displaying outputs ----
mainPanel(
fluidRow( #manipulates the original dataframe given user selection
column(4,
selectInput("year", #selection for the year variable
"Year:",
c("All",
unique(as.numeric(df$Year))))
),
column(4,
selectInput("country", #selection for the country variable
"Country:",
c("All",
unique(as.character(df$Country))))
),
column(4,
selectInput("continent", #selection for the continent variable
"Continent:",
c("All",
unique(as.character(df$Continent))))
)
),
# Create a new row for the table
DT::dataTableOutput("table"),
# Create a new column for the text to be displayed
column(12,
verbatimTextOutput("columns") #column to display col count
),
column(12,
verbatimTextOutput("rows") #column to display row count
),
column(12,
verbatimTextOutput("data_ex") #column to display more information text
)
)
)
)
Thank you!!
The problem is that you are using df$...... inside the UI. If you define df inside the server function, it is not defined in the UI. So you get this error because R recognizes df as the function provided by the 'stats' package (an object of type "closure" is a function).
Up front: StéphaneLaurent's answer is the first thing you need to fix. Below is not causing that error, though I still recommend the changes for other reasons.
In your rows and cols functions, you are accessing input$ directly. This is wrong for at least two reasons:
(general functional programming) Your functions are breaching scope, reaching out to things they were not explicitly passed. This can be a bit about programming style, but functions that use variables not explicitly passed to it can be difficult to troubleshoot.
input$ can only be accessed from within a reactive*, observe*, or render* block (i.e., something that is shiny-reactive). Nothing outside any of those should try to do anything with input$ or output$.
As a fix, make the functions agnostic to shiny by making them self-contained and just working scalars/vectors. (I'll also reduce the logic a little.)
#Generate a function to show the number of rows w/ any given dataframe selection/restriction
rows = function(year, country, continent) {
data <- df %>%
filter(
year == "All" | year == Year,
country == "All" | country == Country,
continent == "All" | continent == Continent
)
return(nrow(data)) #returns number of rows of the data
}
# ...
output$rows <- renderText({
paste("Number of Rows (Records):" , rows(input$year, input$country, input$continent) )
})
Frankly, your cols function is a little odd ... you can change the number of rows of a frame all day long, but the number of columns does not change. Unless you dplyr::select some columns away, it should always be exactly ncol(df).
As for the reduction of logic, your if statements embedded within your dplyr::filter chain aren't wrong, but I think the more R-idiomatic way to do it is what I've suggested. In your case, if a variable is "All", then it returns a single TRUE, which dplyr::filter applies to all rows. If not, then it returns a logical vector (1 for each row) indicating if the frame's variable matches the selected input.
In my version, I do something very similar: the first year == "All" will still resolve to a single logical (assuming year, from input$year), but the right-hand-side will be as long as the number of rows. You can test what this looks like:
TRUE | c(T,F,T,F)
# [1] TRUE TRUE TRUE TRUE
FALSE | c(T,F,T,F)
# [1] TRUE FALSE TRUE FALSE
I'm doing some touch to my shiny app , the problem i'm encountering is that i can't handle the errors using tryCatch like :
tryCatch({
# expr
},
error = function(e) {
# handle the error
}
I'm using the Apriori algorithm within my application ,when the user choose a dataset ,he can also adjust the values of min-support and min-confidence, but sometimes with some values of these, apriori algorithm returns 0 rules , and the error occurs when trying to plot the graph of the association rules .
Here's a small spinet of my code so far :
Getting the file
...
...
...
Find the association rules :
rules <- reactive({
validate(
need(input$file, "Please choose a data set")
)
transactions = read.transactions(
file = file(input$file$datapath),
format = "basket",
sep = ","
)
minValue <- min(length(transactions),input$visualization)
rules <-
apriori(transactions[0:minValue],
parameter = list(
support = input$min_supp,
confidence = input$min_conf
))
print(length(transactions[0:minValue]))
return(rules)
})
Plot the obtained association rules :
output$graphChart <- renderPlot({
Sys.sleep(1)
validate(
need(input$file, "Please choose a data set")
)
set.seed(42)
# validate(
# need(length(rules()) == 0, "zero rules")
# )
tryCatch({
plot(rules(), method = "graph")
})
error = function(condition){
print('there was an error')
}
})
But nothing changed i still get the error and no message printed in the R studio's console
I tried this but it doesn't help me get rid of the error,
By the way i also get errors on other tabs when no rules found .
EDITED
As Pork mentioned in his comment ,i tried :
output$graphChart <- renderPlot({
Sys.sleep(1)
validate(
need(input$file, "Please choose a data set")
)
set.seed(42)
# validate(
# need(length(rules()) == 0, "zero rules")
# )
tryCatch({
plot(rules(), method = "graph",)
})
error=function(cond) {
message(cond)
return(NA)
}
warning=function(cond) {
message(cond)
# Choose a return value in case of warning
return(NULL)
}
})
And the error persist again,
Can someone help me please ?
Any suggestions or advice would be appreciated!
Thanks.
Here is a small example of how you may use tryCatch block. We shall use showNotification to notify the user of the error
library(shiny)
ui <- fluidPage(
sidebarPanel(width = 2,
selectInput("data","data",choices = c(1,2),selected = 1)
),
mainPanel(
plotOutput("graphChart")
)
)
server <- function(input, output, session) {
rules <- reactive({
if(input$data == 1){
return(mtcars$mpg)
}else{
"some error"
}
})
output$graphChart <- renderPlot({
tryCatch({
plot(rules())
}, warning = function(w) {
showNotification('there was a warning','',type = "error")
return()
}, error = function(e) {
showNotification('there was an error','',type = "error")
return()
}, silent=TRUE)
})
}
shinyApp(ui, server)
In the example below, I have 3 DT::datatables. I want the user to be able to select no more than one row from all these tables. I thence use dataTableProxy and selectRow, as per the section "Manipulate An Existing DataTables Instance" in the documentation. It works fine.
However, in my application, I have 24 (call that value N) tables. If I try to adapt the code below to my 24 tables page, I get an horrendous number of lines of code.
What is a smarter way of doing this?
In particular, how can I:
declare the observers dynamically? (answered by user5029763)
know which table (not row) has been clicked upon last? (ie. how to re write reactiveText()?)
EDIT : I copied in user5029763's answer (see below) in the code below.
DTWrapper <- function(data, pl = 5, preselec = c()){
datatable(data,
options = list(pageLength = pl, dom='t',ordering=F),
selection = list(mode = 'single', selected= preselec),
rownames = FALSE)
}
resetRows <- function(proxies, self){
for (i in 1:length(proxies)){
if (self != i){
proxies[[i]] %>% selectRows(NULL)
}
}
}
lapply(1:3, function(id) {
observe({
rownum <- input[[paste0("tab",id,"_rows_selected")]]
if (length(rownum) > 0) { resetRows(proxyList(), id) }
})
})
server = function(input, output) {
output$tab1 <- DT::renderDataTable(DTWrapper(head(mtcars[,1:3]), input$selectTop))
output$tab2 <- DT::renderDataTable(DTWrapper(head(mtcars[,1:3]), input$selectTop))
output$tab3 <- DT::renderDataTable(DTWrapper(head(mtcars[,1:3]), input$selectTop))
proxyList <- reactive({
proxies = list()
for (i in 1:3){
tableID <- paste("tab", i, sep="")
proxies[[i]] = dataTableProxy(tableID)
}
return(proxies)
})
reactiveText <- reactive({
rownum1 <- input$tab1_rows_selected
rownum2 <- input$tab2_rows_selected
rownum3 <- input$tab3_rows_selected
if (length(rownum1) > 0){return(c(rownum1, 1))}
if (length(rownum2) > 0){return(c(rownum2, 2))}
if (length(rownum3) > 0){return(c(rownum3, 3))}
})
output$txt1 <- renderText({
paste("You selected row ", reactiveText()[1]
, " from table ", reactiveText()[2], ".", sep="")
})
}
shinyApp(
ui = fluidPage(
fluidRow(column(4,DT::dataTableOutput("tab1"))
, column(4,DT::dataTableOutput("tab2"))
, column(4, DT::dataTableOutput("tab3")))
,fluidRow(column(4,textOutput("txt1")))
),
server = server
)
The textOutput is: "You selected the Xth row from the Yth table".
After edit:
You could try modules. Another way would be a lapply.
lapply(1:3, function(id) {
observe({
rownum <- input[[paste0("tab",id,"_rows_selected")]]
if (length(rownum) > 0) {
resetRows(proxyList(), id)
msg <- paste0("You selected row ", rownum, ", from table ", id, ".")
output$txt1 <- renderText(msg)
}
})
})
Edited to add reproducible code
I am building a Shiny app and encountered a problem with a while loop inside an observe function. The program does not display the reactive values after while loop. Here is the relevant code snippets from ui.r and server.r
ui.r
library(shiny)
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
textAreaInput("inText", label = "Enter text", rows = 3),
submitButton("Predict")
),
mainPanel(
textOutput("outText"),
textOutput("outCount"),
textOutput("outPred")
)
)
))
Server.r
library(shiny)
library(stringr)
predict <- function(term)
{
if(term == 3)
table <- list()
else
if(term == 0)
table <- c("input","text","empty")
else
table <- c("words","were","found")
return(table)
}
shinyServer(
function(input, output) {
state <- reactiveValues()
observe({
state$inText <- input$inText
state$wcount <- sapply(gregexpr("[[:alpha:]]+", state$inText), function(x) sum(x > 0))
if( state$wcount > 2)
term.c <- 3
else
if( state$wcount == 2)
term.c <- 2
else
if( state$wcount == 1)
term.c <- 1
else
term.c <- 0
cont <- TRUE
while(cont == TRUE) {
if(term.c == 3) {
state$predList <- predict(term.c)
if(length(state$predList) > 0) break
else term.c <- 2
}
if(term.c == 2) {
state$predList <- predict(term.c)
if(length(state$predList) > 0) break
else term.c <- 1
}
if(term.c == 1) {
state$predList <- predict(term.c)
if(length(state$predList) > 0) break
else term.c <- 0
}
if(term.c == 0) {
state$predList <- c("Did", "not", "find", "term")
break
}
}
})
output$outText <- renderPrint({ input$inText })
output$outCount <- renderPrint({ sapply(gregexpr("[[:alpha:]]+", input$inText), function(x) sum(x > 0)) })
output$outPred <- renderPrint({ state$predList })
}
)
Enter two words and the values are displayed properly. Enter three words and an empty list is returned to state$predList which will give it a 0 length. the program should then execute the second if statement and populate state$predList with a non-zero length list. this happens but the display is never refreshed and the program goes into an infinite loop. It jumps to the first line of the observe function and continues in an infinite loop. I see this when I add browser().
Am I not using the reactive values correctly? Thanks for any assistance.