Print console text output in shiny synchronously - r

I recently ran into a problem that as my computing took lots of time, I'd like to show the text output on shiny rather than progress bar or loading message. My function looked like
printText <- function() {
for(i in 1:10){
Sys.sleep(0.1)
print(paste("My text", i))
y = i + 1
}
return(y)
}
I can print it with verbatimTextOutput but I also need the returned value of y. Now I am doing this:
runApp(list(
ui = shinyUI(fluidPage(
titlePanel("Print consol output"),
sidebarLayout(
sidebarPanel(actionButton("go", "Go")),
mainPanel(
verbatimTextOutput("text")
)
)
)),
server = shinyServer(function(input, output, session){
observeEvent(input$go, {
output$text <- renderPrint({
y <- printText()
})
})
})
))
The problem is that if I want to use the returned y I need to create a reactive object, which may take me 2 times longer because I execute printText() twice, while printing and pass to reactive object.
How could I get the value of y and print the text onto shiny without duplicated work? Notice that I'm not gonna use progress bar because my real function is not loop actually. What I want is to capture the text output during the process and get returned value.

You can do this way :
ui.r
textOutput("id")
server.r
output$id<-renderText(input$y)

Related

How to force evaluation in shiny render when generating dynamic number of elements?

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.

Store text input as variable in R shiny

I want to take a user's input and store it as a variable that will be used in a plotting function. My code:
ui <- fluidPage(
mainPanel(
plotlyOutput("plot", width = '100%'),
br(),
textAreaInput("list", "Input List", ""),
actionButton("submit", "Submit", icon = icon("refresh"), style="float:right")
))
server <- function(input, output, session) {
my_text <<- renderText({
req(input$submit)
return(isolate(input$list))
my_text ->> subv
})
bindEvent(my_text,
output$plot <- renderPlotly({
#my very long plot code goes here which takes subv as input. This part has been tested outside of shiny and I know works.
}
I am trying to store the text in the subv variable as it will dictate what the renderPlotly will generate. When I hit submit nothing happens and the variable is only created after the session ends. The newly created subv variable in my environment does not show the text that was inputted but lists subv as an empty function i.e. subv function(...)
Below you can find a working prototype of what you would like to achieve with some information on what the issues were
First, we need to have a textOutput where our text will be shown. I understand this may not be necessary for the actual use case but it is important for this answer's demonstration purposes.
Next, we should not need to set variables to global via <<- or ->>. This is generally not good practice. Instead, we should store our result in a reactive. See also reactiveVals (but this is harder to follow when the app gets complex).
Since we need to only get the value when we click submit, we should use an event bind to only run when we click submit. This is essentially similar to eventReactive.
Finally, we can use bindCache to cache our result on the input list.
ui <- fluidPage(
mainPanel(
plotlyOutput("plot", width = '100%'),
br(),
textAreaInput("list", "Input List", ""),
actionButton("submit", "Submit", icon = icon("refresh"),
style="float:right"),
textOutput("hello_out")
))
server <- function(input, output, session) {
my_text <- reactive({
input$list
}) %>%
shiny::bindCache(input$list
) %>%
shiny::bindEvent(input$submit)
output$hello_out <- renderText({
my_text()
})
}
shinyApp(ui, server)

R Shiny stop for user input and display all plots

I have a script which I want to add to my Shiny app, and the original script can be simplified to the following:
plot(c(1:3),c(2,4,6), main ="This is first plot I want displayed")
a <- menu(c(1:5), title="what would you like to change the first point to?")
plot(c(1:3),c(a,4,6), main ="This is second plot I want displayed")
b <- menu(c(1:5), title="what would you like to change the second point to?")
plot(c(1:3),c(a,b,6), main ="This is second plot I want displayed")
The above script plots the first plot, then waits for user input before plotting second, and waits again for user input before plotting third.
However, when I try to convert it to shiny app as seen below, it never updates the first or the second plot, and the things I've tried to make it stop for user input where shown have not worked.
I have tried using req() but it seems to stop the script entirely so the last things are not run at all, and you have to start the entire script over.
So, how can i make it display all plots in sequence, and how can I make the script stop and wait for input before continuing?
if(interactive()){
ui <- fluidPage(
actionButton("button","Click me"),
selectInput("input", "Input", c(1:10)),
textOutput("text"),
plotOutput("plot")
)
server <- function(input, output) {
a<-1
observeEvent(input$button, {
output$plot <- renderPlot(plot(c(1:3),c(2,4,6), main ="This is first plot I want displayed"))
output$text <- renderText("Please select a number to multiply the first point with")
#This is where I want the script to wait for user input
output$plot <- renderPlot(plot(c((1),(2),(3)),c((input$input),(a),(3)), main="This is plot the second plot"))
a<-a+1
#Here I want the script to wait for user input again
output$plot <- renderPlot(plot(c((1),(2),(3)),c((input$input),(a),(3)), main="This is plot the third plot"))
})
}
shinyApp(ui=ui, server=server)
}
The goal is that it updates the plots when they are rendered in the code, and that it waits for user input until script continues, instead of just keeping going.
Perhaps this is what you want.
req is used to only display when a variable is available. You need to create the second renderUI in the server since you cannot use req in the ui part.
if(interactive()){
ui <- fluidPage(
plotOutput("plot1"),
numericInput ("num1", "Please select a number to multiply the first point with", NA, 1, 10),
plotOutput("plot2"),
uiOutput("num2"),
plotOutput("plot3")
)
server <- function(input, output) {
output$plot1 <- renderPlot(plot(c(1:3),c(2,4,6), main ="This is first plot I want displayed"))
output$plot2 <- renderPlot({
req(input$num1)
plot(c(1:3),c(2*(input$num1),4,(6)),
main="This is plot the second plot"
)
}
)
output$plot3 <- renderPlot({
req(input$num1, input$num2)
plot(c(1:3),c(2*(input$num1)+(input$num2),4,(6)),
main="This is plot the third plot"
)
}
)
output$num2 <- renderUI({
req(input$num1)
numericInput ("num2", "Please select a number to add to first point", NA, 1, 10)
})
}
shinyApp(ui=ui, server=server)
}
To be honest, I´m not 100% sure if I know what you expect, even after reading your text 5 times. I have a guess ;-).
Your pause function, which cause plots to render one step after another can be done with invalidateLater. This has to "live" inside a reactiveValue. I don´t know exactly who is the creator of this function, I saved it in my snippets (all glory to the unknown person).
To render a plot or run a script based on the input of a user, try to catch it by using an if statement.
Hope this helps :-).
library(shiny)
if(interactive()){
ui <- fluidPage(
selectInput("input", "Input", c(1:10)),
actionButton("apply", "Apply"),
textOutput("text"),
plotOutput("plot")
)
server <- function(input, output, session) {
rv <- reactiveValues(i = 0)
maxIter <- 10
observeEvent(input$apply, {
rv$i <- 0
observe({
isolate({
rv$i <- rv$i + 1
})
if (isolate(rv$i) < maxIter){
invalidateLater(2000, session)
}
})
})
output$plot <- renderPlot( {
if(rv$i > 0) {
if(input$input <= 4) {
plot(c((rv$i*1),(rv$i*2),(rv$i*3)),c((1),(2),(3)), main = sprintf("Input <= 4; Round %i", rv$i), type = "l")
} else {
plot(c((rv$i*1),(rv$i*5),(rv$i*4)),c((1),(2),(3)), main = sprintf("Input > 4; Round %i", rv$i), type = "l")
}
} else {
plot(c(1:3),c(2,4,6), main ="This is first plot")
}
})
}
shinyApp(ui=ui, server=server)
}

How to get iterative output from a "for" loop in R shinyapp?

I am looking for a solution in which we can print single iteration output in R shiny. Right now I got the output (a bunch of text output) when For loop ends its working. Is there any way to print itrative output to R shiny mainpanel from for loop ?
Edit 1. Here is a sample code I can not share original code due to official reason. Hope it helps.
library(shiny)
library(shinydashboard)
library(shinythemes)
ui <- dashboardPage(
dashboardHeader(title = "LAP"),
dashboardSidebar(
sidebarMenu(
#menuItem("Introduction", tabName = "intro", icon = icon("info-circle")),
menuItem("test", tabName = "FD", icon = icon("info-circle"))
)),
dashboardBody(
tabItems(
tabItem(tabName = "FD",
fluidRow(
box(verbatimTextOutput("loc") )))
)
)
)
server =shinyServer(function(input, output){
mydata<- reactive({
for(i in 1:100){
print("For Demo Purpose")
}
})
output$loc<- renderPrint({
mydata()
})
})
shinyApp(ui= ui, server = server)
The easiest way that I can think of would be to use the iterated function to append to a reactive variable, and display that variable in another output element.
Just keep output and generation separate. The output element will trigger a redisplay when the reactive value changes, but shouldn't cause odd loops to happen as long as it doesn't modify any variables.
Here's my initial attempt at an example, which doesn't work properly:
## stub UI with an activation button and text output element
ui <- fluidPage(
titlePanel("Iterative output demo"),
sidebarLayout(
sidebarPanel(
actionButton("start","Start Program")
),
mainPanel(
textOutput("showProgressText")
)
)
)
## server stub
server <- function(input, output) {
## reactive list to store result values
iterativeOutput <- reactiveValues();
## text rendering function `showProgressText`
output$showProgressText <- renderText({
sapply(iterativeOutput,paste);
})
## iterative function; modifies the reactive list on each iteration
observeEvent(input$start,{
iterativeOutput <- reactiveValues(); # clear list
for(i in 1:10){
iterativeOutput[[as.character(i)]] <-
sprintf("%2d: For Demo Purpose\n", i);
Sys.sleep(0.2);
}
})
}
This code outputs the modified information all in one go, rather than updating it.
I think the problem is likely to be that Shiny is waiting for the end of the function to check for reactive triggers. This is because, despite appearances, Shiny does not run operations in parallel. The only way to get two things working iteratively is to break the function, allow other functions to run, then resume the function. This is the process mentioned in the Google groups link.
The first implementation in that link works because a timer is set up to run one iteration of the function at one-second intervals. Here's an alternative implementation where the iterative function updates only [once] when a button is pressed:
## UI stub
ui <- fluidPage(
titlePanel("Iterative output demo"),
sidebarLayout(
sidebarPanel(
actionButton("start","Start Program")
),
mainPanel(
htmlOutput("showProgressText")
)
)
)
## Server stub
server <- function(input, output) {
iterativeOutput <- reactiveValues();
output$showProgressText <- renderText(
paste0(sapply(reactiveValuesToList(iterativeOutput),paste),
collapse="<br />\n")
)
observeEvent(input$start,{
#iterativeOutput <- reactiveValues(); # clear list
i <- (input$start-1) %% 10;
iterativeOutput[[as.character(i)]] <-
sprintf("%2d: %d", i, sample.int(1000, 1));
})
}
The insertUI approach is interesting, because it is creating a separate display loop in the middle of a method. I can imagine Shiny code becoming a lot less simple and predictable if that approach were used all over the place.

Shiny Reactivity Explaination (using ObserveEvent)

I am hoping to get some clarity on Shiny's reactivity behavior using the simplified code below as example.
When y is updated in the app, the graph updates.
When x is updated in the app, the graph does NOT update.
I have read Shiny's tutorials and my understanding is that given that I have wrapped both test() and plot() functions in observeEvent, both parameters should not cause the graph to update when changed.
Can someone help explain the logic behind this?
library(shiny)
test <- function(x){x*2}
shinyServer(function(input, output, session) {
observeEvent(input$run, {
x = test(input$x)
output$distPlot <- renderPlot({
if(input$y){
x = x+2
}
plot(x)
})
})
})
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
numericInput("x", "x:", 10),
checkboxInput("y", label = "y", value = FALSE),
actionButton("run", "run")
),
mainPanel(
plotOutput("distPlot")
)
)
))
If you put the line x = test(input$x) inside of the renderPlot it will react when either x or y changes. Essentially the observer creates a reactive output when the action button is clicked the first time, then you simply have a reactive element that responds to changes to inputs inside of it. Hope that helps.
To make it so the graph only updates when the button is clicked, you will probably need to put the data that is being graphed in a eventReactive and use that as the input for the graph.
Something like this:
data <- eventReactive(input$run, {
x = test(input$x)
if(input$y){
x = x+2
}
x
})
output$distPlot <- renderPlot({
plot(data())
})

Resources