how to save the entered text in a shiny app - r

i want to know how to save the entered text by user in a shiny app to use it in the server side.
i want to check if the value that the user has entered is valid or not
in the user side there is this textInput:
textInput("entity1", "Enter a keyword")
and in the server side i want to check the value of the user using this code:
entity1 <- reactive({
if(input$actb >= 0 ){
withProgress(session, min=1, max=15, expr={
for(i in 1:15) {
setProgress(message = 'please wait',detail = 'it may take some time',value=i)
Sys.sleep(0.1)
}
})}
smallE= "[a-z]"
keyword = as.character(input$entity1)
if(match(input$entity1, smallE))
{
message("sorry you did not enter a valid keyword. please try again")
Sys.sleep(1)
}
else
entity1 <- readTweets()
})
I have tried to declare a global variable in the server side to save the input:
if(match(as.vector(userInput), smallE))
userInput is a global variable contains the value of entity1
but there is a error that keep showing saying that:
Error in as.vector(x, mode) :
cannot coerce type 'closure' to vector of type 'any'
any suggestions that may help me?

It is hard to tease apart with just this chunk of code. I would avoid calling out any globals, however, you can assign NULL values until a user has specified input values.
You are also calling your object and your reactive functions both "entity1", so that is a little confusing.
One other thing is that you define the object "keyword" but then never use it again.
And I think you might do better using %in% as your binary rather than match().
Not sure if any of this helps...but the error you are seeing is specifically with the as.vector() part of your code. I am not even sure why you are using that, as any string in the textInput field will come in as a vector already.

There exists a validate function, such as in this example:
validate(
need(input$searchTerm != "", "Please, enter the correct search term")
)

Related

updateNumericInput not updating from reactiveValues

I think I have run into some strange scoping issue that I have fought with for a week now without understanding what is going on.
I have also been unable to really make a small example that have the same problem but I hope the symptoms ring some bells. The real code is also available but the app is pretty complex.
Let me explain the players in the code.
A number of inputs in a bsModal, mainly numericInput.
An observeEvent, lets call it "the reader", fires when a file is read that contains cached results. It updates a reactiveValues object that contains the equivalent of all the inputs in a special S4 object.
Then we have an observe, lets call it "the object creator" that takes all the inputs and updates the reactiveValues` object if any inputs are changed.
an observeEvent, lets call it "the input updater", that fires when the reactiveValues reactive is invalidated and should update all the inputs. This is done to allow other processes to change the inputs by changing the reactiveValues reactive (for example "the object creator"). The first functionality I need is simply that it updates the inputs when the cached results are read by the "the object creator".
So it should go:
"the reader" reads a file --> "the input updater" sees a new reactiveValues reactive and updates the inputs (--> the "the object creator" sees new inputs and re-writes the reactiveValues reactive but they should be what the "the reader" already set).
The issue I have is in the "the input updater". I cannot get it to update the input based on the reactiveValues.
The code looks like this:
observeEvent(settings$processing_local, {
cat("\n\n\n")
print("Modifying inputs")
print(paste0("before ppm input is: ", input$local_ppm))
set <- ppm(settings$processing_local) # THIS DOES NOT WORK
print(paste0("setting: ", set)) # SHOWS CORRECT VALUE
# set <- 1000 # THIS WORKS!
updateNumericInput(session,"local_ppm",value = set)
print(paste0("after ppm input is: ", input$local_ppm))
cat("\n\n\n")
}, priority = 2)
When set is based on the reactiveValues settings$processing_local then the update doesn't happen. The crazy thing is that the output of print does show the right value AND if I hardcode a value to set then it also works.
The full code for 1, 2, 3 and 4.
EDIT 1: Version of the relevant processes based on the example of #cuttlefish44
This is closer to my action app but unfortunately does not have the problem I am experiencing in the full app.
ui <- fluidPage(
numericInput("inNumber", "Input number", 0),
actionButton("but", "Update")
)
server <- function(input, output, session) {
settings <- reactiveValues(aaa = NULL)
# proxy for reading cached file
observeEvent(input$but, {
settings$aaa <- 30
})
observe({
settings$aaa <- input$inNumber
}, priority = 1)
observeEvent(settings$aaa, {
set <- settings$aaa
print(c(set, input$inNumber))
updateNumericInput(session, "inNumber", value = set)
print(c(set, input$inNumber))
}, priority = 2)
}
shinyApp(ui, server)
EDIT 2: In lieu of a working example of the issue I have dockerized my app so it should be possible to see the issue albeit annoying to do. Dockerized app here.
Can be build with docker build --tag mscurate . and run with docker run --publish 8000:3838 mscurate.
After starting the app the issue can be seen by:
click "Load"
Select the one available file
click "local settings"
Now the "ppm" value in the loaded data is 500. But the input was never updated and the reactive is then changed back to the default value of 100.
The logging shows the sequence of events when loading the file:
-------Loading started-------
before the reactive is:
settings not present
after the reactive is:
500
-------Loading finished-------
-------Modifying inputs-------
before ppm input is: 100
setting: 500
after ppm input is: 100 <---- #cuttlefish44's answer explains why this is not updated
--------------
-------updating reactive objects-------
before ppm input is: 100 <---- this should have been updated to 500!
before the reactive object is: 500
after ppm input is: 100
after the reactive object is: 100
--------------
-------Modifying inputs-------
before ppm input is: 100
setting: 100
after ppm input is: 100
--------------
-------updating reactive objects-------
before ppm input is: 100
before the reactive object is: 100
after ppm input is: 100
after the reactive object is: 100
--------------
-------updating reactive objects-------
before ppm input is: 100
before the reactive object is: 100
after ppm input is: 100
after the reactive object is: 100
--------------
I think the problem here is that the “object creator” has a reactive
dependency on the RVs, causing it to invalidate in the same cycle as the
“input updater” when the “reader” updates the RVs. Then the settings are overwritten by the old input values before the update from the "input updater" takes place in the next cycle.
My interpretation of a play-by-play walkthrough would look something like this:
Reader updates settings, invalidating object creator and input updater.
New evaluation cycle starts.
Input updater sends a message to update input from new settings, but the
values in the input object have not changed yet.
Object creator updates settings based on old input, invalidating settings
and consequently input updater and object creator itself.
Input updater sends another message to update input, this time based on the
old settings that object creator just set.
Object creator updates settings again, still based on old input. Invalidaiton
is not triggered because the value hasn't changed.
All outputs are ready, evaluation ends and session is at rest.
Update messages sent by input updater arrive; only the latter is noted, which
changes the input to the old value.
Object creator runs and sets settings to old value. Again, invalidation of
settings is not triggered because the value didn't change.
Evaluation ends again, this time with no pending input messages.
To fix this, remove the RV dependencies from the “object creator”, e.g. with
isolate(). I couldn’t get req() to work with isolate(),
but in this case you could just drop that altogether.
Here’s a minimal example with the problem. Removing the req() here fixes it:
library(shiny)
lgr <- list(debug = function(...) cat(sprintf(...), "\n"))
ui <- fluidPage(
sliderInput("file_number", "Number to \"read from file\"", 0, 10, 5),
actionButton("read", "Read"),
numericInput("number", "Input number to sync", 0)
)
server <- function(input, output, session) {
settings <- reactiveValues(number = NULL)
observeEvent(input$read, {
settings$number <- input$file_number
lgr$debug("Loaded settings from \"file\".")
}, label = "reader")
observe({
req(settings$number) # The dependency on settings
settings$number <- input$number
lgr$debug("Updated settings from input.")
}, priority = 1, label = "object-creator")
observeEvent(settings$number, {
updateNumericInput(session, "number", value = settings$number)
lgr$debug("Set input from settings: %d", settings$number)
}, priority = 2, label = "input-updater")
}
shinyApp(ui, server)
And the log produced after clicking “read”:
Loaded settings from "file".
Set input from settings: 5
Updated settings from input.
Set input from settings: 0
Updated settings from input.
Updated settings from input.
You can get a good look at the process with reactlog:
reactlog::reactlog_enable()
reactlogReset()
shinyApp(ui, server)
reactlogShow()
Your code works, but as far as I see input is static in the event.
See below simple example.
ui <- fluidPage(
sliderInput("controller", "Controller", 0, 20, 10),
numericInput("inNumber", "Input number", 0),
)
server <- function(input, output, session) {
settings <- reactiveValues(aaa = NULL)
observe({
settings$aaa <- input$controller + 3
}, priority = 1)
observeEvent(settings$aaa, {
set <- settings$aaa
print(c(input$controller, set, input$inNumber))
updateNumericInput(session, "inNumber", value = set)
print(c(input$controller, set, input$inNumber))
}, priority = 2)
}
shinyApp(ui, server)
I change controller 10 (default) to 12.
# this is console output
[1] 10 13 0
[1] 10 13 0
[1] 12 15 13
[1] 12 15 13
and the UI screen shot shows inNumber is updated to 15.
But console output shows input isn't updated immediately.
(maybe the updated value is in somewhere of session but I don't know where)

error in function evaluation and running if else loop for specific condition based upon user input

I am trying to write a function that accepts the user input from the command prompt. If user gives input either 'Y' or 'y' or 'Yes' or '1' then the execution of the function happens otherwise it exits from the if else loop:
myfunc <- function(){
if( exists("result") ) { remove(result) }
while(identical(flg_cont <- readline("Do you want to continue? :"), "y")){
## some code here ##
if(!exists("result")){
## some other code here ##
} else {
## some other code here ##
}
}
}
I want to check for user input either 'Y' or 'y' or 'yes' or 'YES' or 'Yes' or '1' is true the function should run for 'empty' (NULL) entry or 0, the function would exit.
Also it seems that if( exists("result") ) { remove(result) } is not correctly placed in the loop, because multiple iterations are deleting the result vector.
You don't need to remove result if you are in a function, by default it will be removed from the functions environment only rm(pos=-1).
Read this to understand what are functions environment http://adv-r.had.co.nz/Environments.html#function-envs.
You could use the %in% statement like
flg_cont <- readline("Do you want to continue? :")
if (flg_cont %in% c("y","Y",1)) {
your statement there
}
From your code, it is also unclear what is result clearly it's not what the user return. So it's not easy to understand what you want to do.
Finally you shoud add a return() statement to your function, while not necessary, it makes your code clearer, it is the input that is finally returned .GLobalEnv

Shiny in R: How can I send a number from server to ui?

For layout reasons, I try to send a single number (number of plots for example) form server to ui. Moreover, I'd like to use this number then to define the width of a box.
Is this possible? And if, how? Thank you very much for your help.
I think if I understand correct, you would want to achieve the following:
Input Field in ui sends a value to server.
Server processes that, and generates a resulting value
The generated value from step 2 goes back to become a part of another input field or probably same input field as Step 1.
You could do something like this in the server:
shinyServer(func = function(input, output, session) {
field1_options <- reactive({
if (!is.null(input$field1)) {
method1(input$field1)
} else {
method2(input$field1)
}
})
observe({
updateSelectInput(
session,
inputId = "field2",
choices=field1_options())
})
}
What this does is simply use the value from field1 to calculate and populate field2, here i've used example of Select Input.

Why doesn't my Shiny (R) actionButton respond after I use a different actionLink?

I'm writing a Shinyapp that enables users, among other things, to input new entries to a mongodb and delete specific rows from it.
I'm trying to add a functionality that would allow to undo the last delete by saving a temporary copy of the row. It seems to work fine, but after I use undo, for some reason the delete button doesn't work anymore, and I can't figure out why.
I thought maybe it has something to do with the fact that there's a few other places where I use observers for the two buttons, but I don't understand why that would cause any problem (and I need them for the app to function properly) - at any rate, they don't prevent me from deleting several rows one after the other so long as I don't use the undo function.
As you can see from the code below, I've put a bunch of print() functions throughout it to try and figure out where it's going. The weird thing - none of them show up! It's like the delete button simply doesn't activate the script once undo was used. Any ideas why?
UPDATE: Here's a short version of server.R and ui.R that reproduces the problem (without using mongodb):
server.R
tempEntry<-NULL
shinyServer(function(input, output, session) {
dat<-data.frame(nums=1:3,ltrs=c("a","b","c"))
## Action: Delete entry
output$delError<-renderText({
input$delButton
isolate({if (!is.na(input$delNum)) {
tempEntry<<-dat[input$delNum,]
output$undo<<-renderUI({
actionLink("undo","Undo last delete")
})
dat<<-dat[-input$delNum,]
print("deleted")
print(dat)
} else print("nope2")
})
})
## Action: Undo delete
output$undoError<-renderText({
input$undo
if (!is.null(input$undo)) {
if (input$undo>0) {
isolate({if (!is.null(tempEntry)) {
dat<<-rbind(dat,tempEntry)
tempEntry<<-NULL
output$delError<<-renderText({""})
print(dat)
} else print("nope3")
}) } else print("undo==0") } else print("undo null")
})
})
ui.R:
library(shiny)
shinyUI(navbarPage("example",
tabPanel("moo",
titlePanel(""),
fluidPage(numericInput("delNum","Row to delete",value=NULL),
actionButton("delButton","Delete row"),
uiOutput("undo"),
div(p(textOutput("delError")),style="color:red"),
div(p(textOutput("undoError")),style="color:blue")
))))
(This also gives an error "argument 1 (type 'list') cannot be handled by 'cat'" after deleting a row, I don't know why... But the problem doesn't seem to be related to that).
Thanks!
That happens because of the output$delError<<-renderText({""}) code that overwrites the original output$delError expression by the empty one, so no surprise output$delError does not trigger on input$delButton any more.
[UPDATE]
The OP's application uses actionButton and actionLink to delete and undelete records from a database, respectively. The 'delete' button is supposed to trigger the delError expression that deletes the record and shows the outcome of deletion (e.g. 'record deleted'). Similarly, the 'undelete' button triggers the undoError expression that puts the record back into the table and reports an outcome of undeletion (e.g. 'record undeleted'). The problem is that undoError has to get rid of the output produced by delError because outputs 'record deleted' and 'record undeleted' don't make much sense when they appear together, but the output 'record deleted' can be removed only by the delError expression.
It seems that this problem can be resolved by modifying delError to make it hide its output when the 'undelete' button (or link) is pressed. But in this case, delError would trigger on both 'delete' and 'undelete' buttons without being able to say which button caused the evaluation, so it would try to delete a record when the 'undelete' button is pressed!
The sample application below provides a way to address this problem by using a global variable that stores the status of the last operation. This status is generated by two high-priority observers (one for 'delete' and another for 'undelete'), which also take care of actual deleting/undeleting of the record. The observers don't produce output that directly goes to the web page, so there is no hassle with getting rid of the messages produced by the other observer. Instead, the status variable is shown by a simple reactive expression.
server.R
tempEntry<-NULL
dat<-data.frame(nums=1:3,ltrs=c("a","b","c"))
shinyServer(function(input, output, session) {
del.status <- NULL
##################
### Observers ####
##################
delete.row <- observe({
if (input$delButton ==0 ) return() # we don't want to delete anything at start
delNum <- isolate( input$delNum ) # this is the only thing that needs to be isolated
if (is.na(delNum)) {
print('nope2')
return()
}
tempEntry <<- dat[delNum,]
dat <<- dat[-delNum,]
output$undo <<- renderUI( actionLink("undo","Undo last delete") )
del.status <<- 'deleted'
},priority=100) # make sure that del.status will be updated *before* the evaluation of output$delError
undelete.row <- observe({
if (is.null(input$undo) || input$undo==0) return() # trigger on undowe don't want to undelete anything at the beginning of the script
dat <<- rbind(dat,tempEntry)
tempEntry <<- NULL
output$undo <<- renderUI("")
del.status <<- 'undeleted'
},priority=100)
##################
### Renderers ####
##################
output$delError <- renderText({
if (input$delButton == 0) return() # show nothing until first deletion
input$undo # trigger on undo
return(del.status)
})
output$show.table <- renderTable({
input$delButton; input$undo # trigger on delete/undelete buttons
return(dat)
})
})
ui.R
library(shiny)
shinyUI(
navbarPage(
"example"
, tabPanel("moo"
, titlePanel("")
, fluidPage(
numericInput("delNum","Row to delete",value=NULL)
, div(p(textOutput("delError")),style="color:red")
, actionButton("delButton","Delete row")
, uiOutput("undo")
, tableOutput('show.table')
)
)
)
)

R shiny - How to transform String into piece of code to use it as input on Server.R?

I am trying to get values from inputs with IDs like "imp1", "imp2", "imp3",...
There's no limit to the amount of 'imps' so it cannot be done manually.
What i thought is that i could make a list called "impIDList" that gets the amount of 'imps' and assign a String to each entry of the list as "imp1", "imp2",...
The problem is server.R doesn't use the String's to process the inputs but it uses only the imp1, or imp2 or imp3... without the quotes.
That happens when i get to:
impIDList<-for(i in 1:numImp){
impID<-paste("imp",toString(i))
imps[[i]]<-input$impID
}
because impID (3rd line) is "imp1", not to imp1.
ui.R
(...)
output$imps<-renderDataTable({
numImp<-(input$num_imp)
imps<-list()
impIDList<-for(i in 1:numImp){
impID<-paste("imp",toString(i))
imps[[i]]<-input$impID
}
})
(...)
If more information is needed (or the question is not in the correct format...) please vote down , but at least say something...I kind of need some help...
Ok, i solved it.
server.R uses inputs like " input$something " and creates outputs like " output$something ".
ui.R displays the outputs like xoutput("something"), and the inputs are created in the widget as, for example:
numericInput({
inputid="imp1",
label="blah blah"
)}
As i had inputs id's like "imp1", "imp2", "imp3",... and needed server.R to use them as input$imp1, input$imp2, input$imp3,... (without the quotes) i only used a parse inside a for loop. I saved the inputs in a list called "imps", another input called "num_imps" got the number of numericInputs.
The code looks like
v_imps<-reactive({
numImp<-(input$num_imp)
imps<-list(c("a","b"))
for(i in 1:numImp){
impID<-paste("imp",toString(i),sep = "")
imps[[1]][i]<-eval(parse(text = paste("input$",impID,sep = "")))
}
imps
})
I was going to put images of what i've done but i have not enough rep.
Thanks anyway

Resources