R блестящие два выхода для одной кнопки действия - PullRequest
Новая
       9

R блестящие два выхода для одной кнопки действия

0 голосов
/ 21 февраля 2019

Я пытаюсь использовать кнопку действия в R Shiny, чтобы запустить медленно работающую модель JAGS.Мне бы хотелось, чтобы какой-то текст появлялся, когда пользователь впервые нажимает кнопку, которая отображает, когда он нажал кнопку, чтобы он знал, что что-то происходит.

Пока действует кнопка действия, но она ждет, пока медленная модель не будет сделана, чтобы отобразить и вывод модели, и текст.

Я посмотрел на следующие вопросы, но они, похоже, не отвечают на мой вопрос, по крайней мере, не так, как я понимаю: R Порядок блестящего исполнения Шаблон для запускасерия блестящих действий

Я новичок в Shiny, поэтому я надеюсь, что это простая проблема.

Run.me <- function(a){
# some fake slow function
# This actually takes about 8 hours in real life 

for (i in 2:a) {
Foo[i] <<- Foo[i-1] + sample(1:20,1)
}}

library(shiny)

Определить логику сервера ---- 

server <- function(input, output) {

observeEvent(input$runmodel, {
output$model.running <- renderText({paste("Model started at", Sys.time())})
})

observeEvent(input$runmodel, {
Foo <<- rep(1, 1e6)
Run.me(1e6)
output$model.ran <- renderTable({head(Foo)})
})

}

Определить пользовательский интерфейс ---- 

ui <- fluidPage(

fluidRow(
column(5, align = "center",
       actionButton("runmodel", "Run the Model")),
textOutput("model.running")
),


fluidRow(
column(5, align = "center", tableOutput("model.ran"))
)
)

Запустить приложение ---- 

shinyApp(ui = ui, server = server)

Ответы [ 2 ]

0 голосов
/ 22 февраля 2019

Возможность, если я правильно понимаю вопрос: 

server <- function(input, output) {

  observeEvent(input$runmodel, {
    Foo <<- rep(1, 1e6)
    Run.me(1e6)
    output$modelran <- renderTable({head(Foo)})
  })

}

js <- "
$(document).ready(function() {
  $('#runmodel').on('click', function(){
    var date = new Date().toLocaleString();
    $('#busy').html('Model started: ' + date);
  });
  $('#modelran').on('shiny:value', function(event) {
    $('#busy').html('');
  });
});
"

ui <- fluidPage(
  tags$head(
    tags$script(HTML(js))
  ),

  fluidRow(
    column(5, align = "center",
           actionButton("runmodel", "Run the Model")),
    tags$p(id = "busy")
  ),
  fluidRow(
    column(5, align = "center", tableOutput("modelran"))
  )

)

enter image description here

0 голосов
/ 21 февраля 2019

В моем приложении, которое также медленно строит модель, я использую индикатор выполнения на сервере.Я знаю, что это не совсем то, о чем вы просите, но вы можете найти это приемлемым решением. 

modeloutput= reactive(withProgress(message = 'Generating JAGs model', value = 0, {
    incProgress(50); generate_jags(params)
}))

output$jags = renderPlot(modeloutput())

Я также буду следить за ответами на этот вопрос, так как я бы также предпочел решение, содержащее сообщение или загрузку.панель в реальном окне печати, где будут отображаться выходные данные.

Я также нашел другое решение, которое блокирует кнопку действия после ее нажатия и имеет небольшую панель загрузки и сообщение о завершении.Это доступно здесь:

https://github.com/daattali/advanced-shiny/tree/master/busy-indicator

...