So I am writing an app that lets the user input some basic operations involving a matrix. At one part, they are asked to "return" the entire matrix, as they would in base R, for which they can either "call" the matrix with rows and columns [1:5,1:5] or simply put in the matrix's name (my.matrix, for instance). I am not able to get the second part working, however, as the app will crash and return the following error: Error in :: NA/NaN argument. I included the segment of code for this particular part in the server:
observeEvent( input$go6, {
sixthinput<- as.numeric(str_extract_all(input$six, "[0-9]+")[[1]])
string6 <- str_extract(input$six, "my.matrix")
sixth.list <- my.matrix[sixthinput[1]:sixthinput[2],sixthinput[3]:sixthinput[4]]
isolate({
buttonValue$go1 = FALSE
buttonValue$go2 = FALSE
buttonValue$go3 = FALSE
buttonValue$go4 = FALSE
buttonValue$go5 = FALSE
buttonValue$go6 = TRUE
buttonValue$go7 = FALSE
})
comparestring <- "my.matrix"
if (isTRUE(identical(sixth.list, my.matrix)) & buttonValue$go6) {
output$display <- renderText({
paste(c("The matrix you extracted contains:"))
})
output$displayMat <- renderTable(
sixth.list
)
output$display2 <- renderText({
print("Correct!")
})
} else if(isTRUE(identical(string6, comparestring)) & buttonValue$go6) {
output$display <- renderText({
paste(c("The matrix you extracted contains:"))
})
output$displayMat <- renderTable(
my.matrix
)
output$display2 <- renderText({
print("Correct!")
})
} else {
output$display <- renderText({
paste(c("The matrix you extracted contains:"))
})
output$displayMat <- renderTable(
sixth.list
)
output$display2 <- renderText({
print("Incorrect")
})
}
})
I am sure it has something to do with the variable "string6," "comparestring," and/or the part where I compare them in the if loop, but I am not sure where/how exactly it is going wrong, other than something is NA. Any clarification is appreciated.
The problem is in these lines:
sixthinput<- as.numeric(str_extract_all(input$six, "[0-9]+")[[1]])
string6 <- str_extract(input$six, "my.matrix")
sixth.list <- my.matrix[sixthinput[1]:sixthinput[2],sixthinput[3]:sixthinput[4]]
When the user inputs my.matrix with no subset operator ([), the value of sixthinput will be numeric(0) because there are no matching numbers. The value of sixthinput[1] will be NA, and you can’t then subset my.matrix by NA. The easiest way to avoid the error would be to check that length(sixthinput) == 4, and if not then avoid subsetting my.matrix.
Related
I'm trying to have the user enter a numeric input, then generate a number of input boxes equal to that first numeric input. I would then like to find the sum of the responses to these secondary numeric inputs. However, I am having trouble accessing these variables in a comprehensive way, since their names are created used numeric variables. Right now when I run it I get this error:
Warning: Error in get: object 'inp21' not found
Thanks
library(shiny)
ui <- fluidPage(
# Application title
titlePanel("Test"),
sidebarLayout(
sidebarPanel(
numericInput("inp1",
"Enter num:",1)
),
mainPanel(
uiOutput("more_inp"),
textOutput("num_inps")
)
)
)
server <- function(input, output) {
counter <- reactiveValues(countervalue = 0)
counter2 <- reactiveValues(counter2value = 0)
output$more_inp <- renderUI({
#Generates number of numeric inputs equal to original numeric input
mylist <- lapply(1:input$inp1, function(i) {
inp_identifier <- paste("inp2", i, sep="")
inp_name<- paste("Input2",i,sep=" ")
list(
numericInput(inp_identifier,inp_name, 5)
)
})
do.call(tagList, unlist(mylist, recursive = FALSE))
})
#Display number of secondary inputs
#Count number of secondary inputs
observeEvent(input$inp1, {
counter$countervalue <- counter$countervalue + 1
})
#Find sum of secondary inputs
output$num_inps<-renderText(input$inp1)
observeEvent(input$inp1,{
for (i in 1:counter$countervalue) {
counter2$counter2value <- counter2$counter2value + get(paste("inp2", i, sep=""))
print(counter2$counter2value)
}
})
}
Run the application
shinyApp(ui = ui, server = server)
Additionaly to r2evans suggestion simply "filter" out the case when an input field cannot be found. It seems that this observeEvent is called before the other input fields can be created. As a consequence, you receive an empty vector (numeric(0)) when you try to access one of them.
observeEvent(input$inp1,{
for (i in 1:counter$countervalue) {
if (isTruthy(input[[paste0("inp2", i)]])) {
counter2$counter2value <- counter2$counter2value + input[[paste0("inp2", i)]]
print(counter2$counter2value)
}
}
})
You aren't checking for the presence before adding. The observeEvent block is firing aggressively, so even though counter$countervalue is 1, there are not additional input fields present, so input[[paste("inp2", i, sep="")]] returns NULL. Anything plus null is numeric(0).
How to find this
observeEvent(input$inp1,{
browser()
for (i in 1:counter$countervalue) {
counter2$counter2value <- counter2$counter2value + get(paste("inp2", i, sep=""))
print(counter2$counter2value)
}
})
Run your app. When it hits the debugger and shows you Browse[2]>, then
counter$countervalue
# [1] 1
counter2$counter2value
# [1] 0
i <- 1L
get(paste("inp2", i, sep=""))
# Error in get(paste("inp2", i, sep = "")) : object 'inp21' not found
input[[ paste("inp2", i, sep="") ]]
# NULL
names(input)
# [1] "inp1"
A quick check could be to look for that paste(.) name in names(input).
Tangent
for (i in 1:n) works fine as long as you are 100% certain that n here will always be 1 or greater. If there is the remote possibility that it will be <1, then the results will be rather unintuitive.
That is, if n is 0, then I would expect the for loop to do nothing. As a vector example,
for (nm in c('a','b')) ... # executes twice GOOD
for (nm in c()) ... # does not execute GOOD
for (i in 1:2) ... # executes twice GOOD
for (i in 1:0) ... # executes twice BAD
The reason is that 1:0 resolves to a reverse sequence, so seq(1, 0) and therefore c(1L, 0L).
A safer alternative if you expect a possible zero is seq_len:
seq_len(2)
# [1] 1 2
seq_len(0)
# integer(0)
(seq(1, length.out=n) is equivalent.)
An even safer alternative if you cannot guarantee "positive only", then
seq_len(max(0, n))
(since seq_len(-1) is an error).
Suggested solution
observeEvent(input$inp1,{
for (i in seq_len(counter$countervalue)) { # or max(0, ...)
nm <- paste("inp2", i, sep="")
if (nm %in% names(input)) {
counter2$counter2value <- counter2$counter2value + input[[nm]]
print(counter2$counter2value)
}
}
})
I am in my server.r file and trying to create an output via renderText with a conditional statement. The below code is throwing me the error:
Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)```
I have a feeling I have the architecture of this code wrong.
if (A > B)
{
output$sample <- renderText({ do some calculation)})
}
else if(A <= B)
{
output$sample <- renderText({do some other calculation)})
}
I have attempted to reformat to the below but get the same error. I feel I may be fundamentally wrong in my approach here. Any help welcomed.
output$sample <-
if (A > B)
{
renderText({ do some calculation)})
}
else if(A <= B)
{
renderText({do some other calculation)})
}
Server part where the issue was has been resolved here with some reactive objects. Please try this
ab <- reactive({req(input$account_value) - req(input$blocked_funds)})
# free funds
output$free_funds <- renderText({ab()})
# current margin
cm <- reactive({
req(input$account_value,input$blocked_funds)
if (input$account_value > input$blocked_funds){
curmargin <- round(input$account_value/(input$account_value+input$blocked_funds), digits = 2)
}else {
curmargin <- round((.5*(input$account_value))/input$blocked_funds, digits = 2)
}
})
output$current_margin <- renderText({cm()})
rm <- reactive({
req(input$account_value,input$blocked_funds)
round(input$account_value/(input$account_value + input$blocked_funds*2.5)*100,digits = 1)
})
# New margin
output$revised_margin <- renderText({
paste(rm(),"%",sep = "")
})
I have written my logic and I am also getting the Output in the form of thershold values . But I need it in the form of Yes Or No . The dataset attribute which I am using for prediction is also Yes/No .But still it throws Thershold values. Yes -> Risky Person No -> Safe Person
This is my server code.
credfraudframe <- data.frame(credfrauddata$Credit.Score,credfrauddata$Annual.Income,credfrauddata$Current.Loan.Amount,credfrauddata$Number.of.Open.Accounts,credfrauddata$Current.Credit.Balance,credfrauddata$Maximum.Open.Credit,credfrauddata$Bankruptcies)
credfraudfit <- randomForest(Bankruptcies ~ Credit.Score+Annual.Income+Current.Loan.Amount+Number.Of.Open.Accounts+Current.Credit.Balance+Maximum.Open.Credit,
data=credfraudframe,na.action = na.roughfix)
cred_reactive1 <- eventReactive(input$eligibility,{
usercredcs <- input$uicscred
})
cred_reactive2 <- eventReactive(input$eligibility,{
userannualinc <- input$uiannualincome
})
cred_reactive3 <- eventReactive(input$eligibility,{
userlamt <- input$uilamt
})
cred_reactive4 <- eventReactive(input$eligibility,{
usernoopenacc <- input$uiopenacc
})
cred_reactive5 <- eventReactive(input$eligibility,{
usercurrcredbal <- input$uicurrcredbal
})
cred_reactive6 <- eventReactive(input$eligibility,{
usermaxopencred <- input$uiopencred
})
credfraudrv <- reactiveValues(usercredcs = NULL,
userannualinc = NULL,
userlamt = NULL,
usernoopenacc = NULL,
usercurrcredbal = NULL,
usermaxopencred = NULL)
observeEvent(input$eligibility,{
req(input$uicscred, input$uiannualincome, input$uilamt, input$uiopenacc,input$uicurrcredbal,input$uiopencred)
credfraudrv$usercredcs <- input$uicscred
credfraudrv$userannualinc <- input$uiannualincome
credfraudrv$userlamt <- input$uilamt
credfraudrv$usernoopenacc <- input$uiopenacc
credfraudrv$usercurrcredbal <- input$uicurrcredbal
credfraudrv$usermaxopencred <- input$uiopencred
}
)
credfraudpred <-reactive({
predict(credfraudfit,
newdata=data.frame(Credit.Score=credfraudrv$usercredcs,
Annual.Income=credfraudrv$userannualinc,
Current.Loan.Amount=credfraudrv$userlamt,
Number.Of.Open.Accounts=credfraudrv$usernoopenacc,
Current.Credit.Balance =credfraudrv$usercurrcredbal,
Maximum.Open.Credit=credfraudrv$usermaxopencred))
})
output$text2 <- renderText({
paste("Is this Customer Risky ",credfraudpred())
})
I have used my "Output" variable as Bankruptcies Which is also in the character format(Yes or no)
When I submit to check eligibility It is throwing some thershold values as output
This is what I am getting .. I need it as Yes -> The Customer is a risky person No -> The customer is a Safe Person
Please help me solve this issue . In which part I have to edit my code to get the desired Format(Yes/ No)
Before this code, you need to specify your conditions for what is risky and what is not risky:
output$text2 <- renderText({
paste("Is this Customer Risky ",credfraudpred())
})
For example, before this code, you might put:
if credfraudpred() > 0.1 {
credfraudlabel = 'Yes, the customer is a risky person'
} else {
credfraudlabel = 'No, the customer is not a risky person'
}
Then, you could alter your code to replace credfraudpred with credfraudlabel:
output$text2 <- renderText({
paste("Is this Customer Risky: ",credfraudlabel)
})
I am subsetting a dataframe in a shiny app based on various inputs the user can specify. If an input field is empty, no subsetting should be done. I can achieve this inside a reactive statement with
data_subset <- reactive({
if (!is.null(input$input_a)) {data <- subset(data, a %in% input$input_a}
# lots of similar if statements for inputs b, c, d ...
data
})
where I have lots of these if statements checking if an input is NULL. But with more than 10 or 20 such statements one below the other, the code looks kind of messy and lengthy.
Is there a better way to do this? Maybe req can help here?
You should be able to tweak this code to suit your needs. input is a list containing the different elements you are using to subset. You can extract those that you need in your reactive function and then use higher order function Reduce to come up with a logical vector to index your data.
# Setup example
input <- list(input_vs = NULL, input_am = 1, input_gear = 4) # Inputs coming from ui
data <- mtcars # Data
# In the reactive expression
inpt <- reactiveValuesToList(input)
indx <- inpt[grepl("input", names(inpt))] # Extract the inputs you want
names(indx) <- gsub("input_", "", names(indx)) # Remove the prefix to get the associated variable names
indx <- Filter(Negate(is.null), indx) # Remove the null ones
# Find indices
indx <- lapply(seq_along(indx), function(i) data[, names(indx)[i]] %in% indx[[i]])
indx <- Reduce(`&`, indx)
# Subset data
data[indx, ]
I've just come up with a solution using a simple for loop. I defined a helper function to check if an input is empty and subset only if an input is not empty.
library(shiny)
data <- iris
# return TRUE if shiny input is empty, e.g. NULL, "", FALSE
is_input_empty <- function(ui_input) {
if (is.null(ui_input)) return(TRUE)
if (length(ui_input) != 1) return(FALSE)
if (ui_input == "") return(TRUE)
if (ui_input == FALSE) return(TRUE)
return(FALSE)
}
ui <- fluidPage(
selectizeInput("Species", "Species", choices = levels(data$Species),
multiple = TRUE, selected = c("versicolor", "setosa")),
plotOutput("plot_iris")
)
server <- function(input, output) {
data_subset <- reactive({
input_vars <- "Species"
# iterate over the inputs, if not NULL subset the data
for (i in input_vars){
if (!is_input_empty(input[[i]])) {data <- data[data[, i] %in% input[[i]], ]}
}
data
})
output$plot_iris <- renderPlot(plot(data_subset()$Sepal.Length,
data_subset()$Sepal.Width))
}
shinyApp(ui, server)
I am trying to write a Shiny app for a class I'm teaching that draws a random sample from a dataset and computes summary statistics. Whenever I press the reset button on the UI, a new subset should be sampled. Here is my code so far:
shinyServer(function(input, output) {
# Output for Ch. 1 Problems: Central Tendency
# Prepare data
observeEvent(input$Ch1.Prob.CT.reset, {
Ch1.Prob.CT.n <- sample(8:12, 1)
Ch1.Prob.CT.obs <- sample(1:nrow(cars), Ch1.Prob.CT.n)
})
data <- eventReactive(input$Ch1.Prob.CT.reset, {
cars[Ch1.Prob.CT.obs, 'dist', drop=F]
})
# Outputs
output$Ch1.Prob.CT.Data <- renderDataTable({
data()
})
output$Ch1.Prob.CT.Mean.out <- renderUI({
if (is.na(input$Ch1.Prob.CT.Mean.in)) { # Error checking
p("No answer provided")
} else if (round(input$Ch1.Prob.CT.Mean.in, digits = 4) == round(mean(Ch1.Prob.CT.data[,1]), digits = 4)) {
p("Correct", style = "color:green")
} else {
p("Incorrect", style = "color:red")
}
})
})
The problem is that the sample is not random; it is always the same, every time. Even when I press the reset button, the sample is exactly the same as the one before.
Why is Shiny not randomizing? And how can I make it randomize again?
Add a line such as
set.seed(as.integer(Sys.time()))
before you need random numbers
Such code:
observeEvent(input$xxx, {
x <- ...
})
f <- eventReactive(input$xxx, {
[do something with x]
})
does not work.
You can simply remove the observer and do:
f <- eventReactive(input$xxx, {
x <- ...
[do something with x]
})
If you want to use a variable subject to modifications inside an observer, you have to use a reactive list, like this :
values <- reactiveValues()
values$x <- [initial value of x]
observeEvent(input$xxx, {
values$x <- ...
})
(In addition, don't use some dots (.) in the names of the shiny elements.)