I have a little problem with a loop. Here is the code of the loop:
for (i in 1:length(input$count))
{
id<-paste("text",i)
titles[i]<-input$id
}
This returns the following error
Error in titles[i] <- input$id : replacement has length zero
ui.R
library(shiny)
ui <- fluidPage(
numericInput("count", "Number of textboxes", 3),
hr(),
uiOutput("textboxes")
)
server.R
server <- function(input, output, session) {
output$textboxes <- renderUI({
if (input$count == 0)
return(NULL)
lapply(1:input$count, function(i) {
id <- paste0("text", i)
print(id) // its prints the text1, text2,text3
numericInput(id, NULL, value = abc)
print(input$text1) //it should print value abc , but it is not, why??
})
})
}
This error indicates that your input id is either NULL or a length 0 vector: make sure the indices are correct.
Additionally, in R it is usually best to avoid for loops as they tend to be pretty slow: see Why are loops slow in R?. There's almost always a way to avoid using a for loop and using a vectorised function instead, although the example as it stands doesn't provide enough detail to actually suggest a function.
Related
I generate a dynamic number of valueBox in my shiny, and this number can change depending of the user input.
I managed to handle this with a renderUI where I put the wanted number of valueBoxOutput, and I have an observe that will feed them with the content using renderValueBox.
My problem is: the code in the renderValueBox, for some reason, is actually executed after the observe is finished, so because the renderValueBox is in a loop (to have a dynamic number of them) but the code is executed for all the output after the loop, all my output will get the last value of the loop.
Here is a min reprex:
library(shiny)
library(shinydashboard)
library(shinyWidgets)
# Function
compute <- function(id)
{
print(paste("Compute ", id))
return(id)
}
# UI
ui = shinyUI(fluidPage(
titlePanel("Compare"),
useShinydashboard(),
sidebarLayout(
sidebarPanel(
numericInput("numitems", label = "Number of items", min = 1, max = 10, value = 2)
),
mainPanel(
uiOutput("boxes")
)
)
))
# Server
server = shinyServer(function(input, output, session) {
data <- reactiveValues(
ids = list()
)
output$boxes <- renderUI({
print("boxes")
box_list <- list()
id_list <- list()
for(id in 1:(input$numitems)) {
id_box <- paste0("box_", id)
print(paste("boxes - ", id_box))
id_list <- append(id_list, id_box)
box_list <- append(
box_list,
tagList(
shinydashboard::valueBoxOutput(id_box)
)
)
data$ids <- id_list
}
print("boxes end")
fluidRow(box_list)
})
observe({
print("observe")
for(id_box in data$ids) {
print(paste("observe - ", id_box))
output[[id_box]] <- shinydashboard::renderValueBox(valueBox(id_box, compute(id_box), icon = icon("circle-info"), color = "teal"))
}
print("end observe")
})
})
# Run
shinyApp(ui = ui , server = server)
Here is the result:
And the console output:
As you can see the compute (and the render in general) is done after the end of the observe function, and both output will use the last id_box that were set (so the last loop, box_2), instead of correctly using box_1 and box_2.
I tried using force, computing valueBox outside the render, using reactive lists, nothing worked, because whatever I do the render is evaluated after the observe so only the last loop values will be used no matter what.
Do anyone know a way to force execution during the loop ? Or see another way of achieving the same result ?
Why it's always after spending hald a day on a problem, looking for dozens of posts and forum, don't find anything, finally decide to ask a question... that a few minutes later I finally find an answer.
Anyway, one way to correct this (found here) is to encapsulate the render inside the local function, like this:
observe({
print("observe")
for(id_box in data$ids) {
print(paste("observe - ", id_box))
local({
tmp <- id_box
output[[tmp]] <- shinydashboard::renderValueBox(valueBox(tmp, compute(tmp), icon = icon("circle-info"), color = "teal"))
})
}
print("end observe")
})
Now the compute is still called after the end of the observe, but the tmp variable has the correct value:
The result is what I wanted:
For the record, I had already tried to use the local function, but if you don't copy the id_box inside another variable just for the local bloc, it won't work.
I'm trying to merge two uploaded data frames, output it as a table, then being able to download it and reset the inputs, but only get the error: "Error 'by' must match numbers of columns".
I have trouble understanding reactiveValues I guess, since I can't simply call them as data frames in the app...
library(shiny)
library(shinyjs)
library(readxl)
library(DT)
ui <- fluidPage(
useShinyjs(),
fileInput('inFile1', 'Choose file'),
fileInput('inFile2', 'Choose file'),
actionButton('reset', 'Reset'),
tableOutput('overlap')
)
server <- function(input, output, session) {
rv <- reactiveValues()
observe({
req(input$inFile1)
rv$data1 <- readxl::read_xls(input$inFile1$datapath)
})
observe({
req(input$inFile2)
rv$data2 <- readxl::read_xls(input$inFile2$datapath)
})
observeEvent(input$reset, {
rv$data1 <- NULL
rv$data2 <- NULL
reset('inFile1')
reset('inFile2')
})
dataframe<-reactive({
if (!is.null(rv$data1) | !is.null(rv$data2))
return(NULL)
df <- merge(as.data.frame(rv$data1),as.data.frame(rv$data2),by.x = 1,by.y = 1)
colnames(df) <- c("GeneID",paste0(colnames(rv$data1)[2:ncol(rv$data1)],"_file_1"),
paste0(colnames(rv$data2)[2:ncol(rv$data2)],"_file_2"))
df
})
overlap1 <- reactive({
if(!is.null(dataframe()))
dataframe()
})
output$overlap <- renderDataTable({
datatable(overlap1())
})
}
shinyApp(ui, server)
At a first glance your reactive expressions look fine to me. And given that error message the error is caused by merge(). Taking a closer look there, what strikes me are those is.null checks at the top of the dataframe<-reactive(. The condition (!is.null(rv$data1) | !is.null(rv$data2)) means that you are trying to merge two objects that are NULL because only then the code wont't stop with return(NULL). If one or both rv-values are "Truthy" the code won't run and all the reactive is going to return is NULL.
I used isTruthy() below. I think it helps in two ways:
isTruthy() checks if the values contain anything "usable". That way, you do not have to care about how rv is initialised. It could be NA or integer(0) or anything else that is meaningless. isTruthy handles all these cases. Merging now only takes place when there are two values with "meaningful" data (note that this does not necessarily mean that the data can be coerced to data.frame).
It avoids a complicated double negative in the if-statement.
dataframe <- reactive({
if (isTruthy(rv$data1) && isTruthy(rv$data2)) {
df <- merge(rv$data1, rv$data2, by.x = 1,by.y = 1)
colnames(df) <- c("GeneID", paste0(colnames(rv$data1)[2:ncol(rv$data1)], "_file_1"),
paste0(colnames(rv$data2)[2:ncol(rv$data2)], "_file_2"))
} else df <- NULL
df
})
Final tweak: I removed as.data.frame in the merge statement because the first thing merge is trying to do is coerce the arguments to a data frame.
I have been trying to create a dice/gambling simulator with Shiny, but I am having two problems (though both may be linked to the one error, I am not sure). I basically create a reactiveValue, set at 10000 (dollars) initially within the server, along with a sample( ) function that only draws from between 1-6 (for a six-faced die) and allows the user to choose the number of dice/tosses. I then set up an observeEvent where an if-loop determines that if the random numbers generated within the sample( ) function are equal to or greater than the number of dice that the user bet would show up, and so long as the reactiveValue remains about 1, then the user can double their "money." If their bet is less than what was generated by sample, then they lose half. If they lose so much that they are below one, then they aren't allowed to bet anymore or at least told that they are broke, but this isn't such an important part to the code.
Right now, I seem to be unable to get the if loop to work, as it throws the error:
Warning: Error in if: missing value where TRUE/FALSE needed
library(shiny)
ui <- fluidPage(
pageWithSidebar(
titlePanel("Feelin' Lucky?"),
sidebarPanel(
p("In this simulation, you can select the number of dice you would like to roll,
and then make a 'bet' on the numbers that will show up with every roll. If there are more faces
than the number you guessed, then you still win. If there are less faces, however,
you will lose 'money,' displayed at the top of the main panel. Give it a try and
good luck!"),
numericInput("dicenum", "Enter the number of dice to roll:", 1),
numericInput("face", "What face do you think will be rolled?", 1),
numericInput("bet", "How many of this face do you think will be rolled?", 1),
actionButton("go1", "GO!")
),
mainPanel(
htmlOutput("the.dough"),
htmlOutput("the.bet"),
textOutput("results"),
htmlOutput("results2"),
htmlOutput("warning")
)
)
)
server <- function(input, output, session) {
money <- 10000
output$the.dough <- renderText(
paste(money)
)
buttonValue <- reactiveValues(go1=FALSE)
rv <- reactiveValues(money.tot = 10000)
observeEvent(input$go1,{
isolate({buttonValue$go1=TRUE})
the.roll <- sample(1:6, size = input$dicenum, replace=TRUE)
the.face <- as.numeric(input$face) #Dice Face Bet
amount <- as.numeric(input$bet)
output$warning <- renderText({
goop <- sum(the.roll==the.face)
if ((goop >= amount) & (rv$money.tot>1)) {
rv$money.tot <- sum(rv$money.tot, rv$money.tot*2-rv$money.tot)
paste("Well-done! You won the bid! You now have: $", rv$money.tot)
} else if ((goop < amount) & (rv$money.tot>1)) {
rv$money.tot <- rv$money.tot-(rv$money.tot/2)
paste("Darn! It looks like you lost the bid! You now have: $", rv$money.tot)
} else if (rv$money.tot<1) {
paste("You are broke! You cannot bid anymore money!")
} else {
NULL }
})
})
}
shinyApp(ui, server)
I have looked up what this means, but I cannot find a case that would exactly explain why it is doing it in my script, especially since the if loop works when written as a base R if loop, i.e. no reactivity or Shiny involved. Example of the working loop:
rvv <- 10000
face.guess <- 4
throw <- sample(1:6, size = 10, replace = TRUE)
guess.howmany <- 2
if (sum(throw==face.guess)>=guess.howmany & rvv>1) {
rvv <- sum(rvv, rvv*2-rvv)
print("Woohoo!")
print(rvv)
} else if (sum(throw==face.guess)<guess.howmany & rvv>1){
print("Darn")
rvv <- rvv-(rvv/2)
print(rvv)
} else if (rvv<1) {
print("You are broke! You can't bid anymore money!") }
Other times, the if loop does seem to partially work, but only to jump to the last option, somehow reducing the starting reactiveValue to below 1 and declaring them broke on the first bid, which should not be possible.
My computer is wonky right now, too, so I apologise if there is syntax issues in the above - it could be partly from not being able to copy/paste properly at the moment.
Any help is much appreciated!
EDIT: Fixed code. I also figured out that when the user gets the bid right, there is a delay, and then it throws the above error. When they guess too high/wrong, it displays the last option (print("You are broke!")), which seems to suggest there is a problem explicitly with how I am invoking the other condition ("goop"). I just do not get what.
I figured out a fix for it: I basically had to take the if loop outside of the renderText( ), and instead imbed multiple renders within each step of the if loop. I copied the corrected server portion below. Probably not the most elegant fix, but it works as I wanted:
server <- function(input, output, session) {
money <- 10000
output$the.dough <- renderText(
paste(money)
)
buttonValue <- reactiveValues(go1=FALSE)
rv <- reactiveValues(money.tot = 10000)
observeEvent(input$go1,{
isolate({buttonValue$go1=TRUE})
the.roll <- sample(1:6, size = input$dicenum, replace=TRUE)
the.face <- as.numeric(input$face) #Dice Face Bet
amount <- as.numeric(input$bet)
goop <- sum(the.roll==the.face)
if (isTRUE(goop >= amount) & isTRUE(rv$money.tot>1) & buttonValue$go1) {
rv$money.tot <- sum(rv$money.tot, rv$money.tot*2-rv$money.tot)
output$warning <- renderText({
paste("Well-done! You won the bid! You now have: $", rv$money.tot)
})
} else if (isTRUE(goop < amount) & isTRUE(rv$money.tot>1) & buttonValue$go1) {
rv$money.tot <- rv$money.tot-(rv$money.tot/2)
output$warning <- renderText({
paste("Darn! It looks like you lost the bid! You now have: $", rv$money.tot)
})
} else if (isTRUE(rv$money.tot<1) & buttonValue$go1) {
output$warning <- renderText({
paste("You are broke! You cannot bid anymore money!")
})
} else {
NULL }
output$results <- renderText(
paste("You bid that there would be:", amount, "of the", the.face, "face.")
)
output$results2 <- renderText(
paste("Actual Result:", as.numeric(sum(the.roll==the.face)), "of the", the.face)
)
})
}
Hope this helps anyone who is trying to do anything similar!
So, I've been on google for hours with no answer.
I want to create a user-defined function inside the server side that takes inputs that I already know to wrap reactive({input$feature)} but the issue is how to incorporate reactive values as inputs too.
The reason why I want to do this is because I have a navbarPage with multiple tabs that shares elements such as same plots. So I want a user defined function that creates all the similar filtering and not have to create multiple of the same reactive expression with different input and reactive variable names which take up 2000+ lines of code.
server <- function(input, output) {
filtered_JointKSA <- reactiveVal(0)
create_filtered_data <- function(df, input_specialtya, filtered_JointKSA) {
if (input_specialtya == 'manual') {
data <- filter(data, SPECIALTY %in% input_specialtyb)
}
if (filtered_JointKSA != 0) {
data <- filter(data, SPECIALTY %in% filtered_JointKSA)
}
reactive({return(data)})
}
filtered_data <- create_filtered_data(df,
reactive({input$specialty1}),
filtered_JointKSA())
observeEvent(
eventExpr = input$clickJointKSA,
handlerExpr = {
A <- filtered_JointKSA(levels(fct_drop(filtered_data()$`Joint KSA Grouping`))[round(input$clickJointKSA$y)])
A
}
)
This gets me an error:
"Error in match(x, table, nomatch = 0L) :
'match' requires vector arguments"
The error is gone if I comment out where I try to create filtered_data but none of my plots are created because filtered_data() is not found.
What is the correct approach for this?
Ideally, I would like my observeEvents to be inside user defined functions as well if that has a different method.
This example may provide some help, but it's hard to tell without a working example. The change is to wrap the call to your function in reactive({}) rather than the inputs to that function, so that the inputs are all responsive to user input and the function will update.
library(shiny)
ui <- fluidPage(
numericInput("num", "Number", value = NULL),
verbatimTextOutput("out")
)
server <- function(input, output){
## User-defined function, taking a reactive input
rvals <- function(x){
req(input$num)
if(x > 5){x * 10} else {x*1}
}
# Call to the function, wrapped in a reactive
n <- reactive({ rvals(input$num) })
# Using output of the function, which is reactive and needs to be resolved with '()'
output$out <- renderText({ n() })
}
shinyApp(ui, server)
I would like to know how to update a global variable by calling a function and return it. Here is my brief code from 'server.R'. My ui.R consists of several lines of code to display the output.
sentence <- ""
result <- c()
updateSen <- function(input){
print("function executed!")
if(length(sentence) == 0){
result <<- c(result, "First")
sentence <<- paste(sentence, input, sep = " ")
}else{
result <<- c(result, input)
sentence <<- paste(sentence, input, sep = " ")
}
}
shinyServer(
function(input, output){
word <- reactive({
word <- input$tid
})
output$oid <- renderText({
paste(input$tid)
})
output$sen <- renderText({
updateSen(word())
sentence
})
}
)
What I would like to do with the code above is this...
1. Ask user to type a word
2. make a sentence with a word user typed
3. run a function
4. display a sentence
However, it seems like it doesn't work well and there are many things I don't know what's going on. First of all, I have no idea why updateSen() function is called a lot of times during the program execution. Second, the global variable 'result' does not change after the first execution. I would like this variable to be updated.
From what I understand, the variable 'result' will start changing automatically once you apply reactive keyword. Try
updateSen <- reactive(function(input){
print("function executed!")
...
}
})
Secondly, I think you should not have variables like sen and result as 'global' rather you should work with textInput() function and variables like input$sentence.
I suggest you read more about reactive variables and functions in Shiny.