2015-06-02 11 views
10

मान लें कि मेरे पास एक चमकदार ऐप है जिसमें एक ऐसा फ़ंक्शन है जो चलाने में लंबा समय ले सकता है। क्या एक "स्टॉप" बटन होना संभव है जो ऐप को रोकने के बिना लंबे समय से चलने वाले कॉल को रोकने के लिए आर को बताता है?क्या चमकदार के अंदर आर कोड को निष्पादित करना बंद करना संभव है (चमकदार प्रक्रिया को रोक दिए बिना)?

मैं क्या मतलब का उदाहरण:

analyze <- function() { 
    lapply(1:5, function(x) { cat(x); Sys.sleep(1) }) 
} 

runApp(shinyApp(
    ui = fluidPage(
    actionButton("analyze", "Analyze", class = "btn-primary"), 
    actionButton("stop", "Stop") 
), 
    server = function(input, output, session) { 
    observeEvent(input$analyze, { 
     analyze() 
    }) 
    observeEvent(input$stop, { 
     # stop the slow analyze() function 
    }) 
    } 
)) 

संपादित करें: x-post from shiny-discuss

+0

मेरे पास "विश्लेषण" बटन है जिसमें कई मिनट लग सकते हैं। कभी-कभी मुझे एहसास होता है कि मैं कुछ विकल्प सेट करना भूल गया हूं और मैं इसे रद्द करना चाहता हूं ताकि मैं एक छोटा समायोजन कर सकूं। पुनरारंभ करने के लिए ऐप को मारना असुविधाजनक है, मुझे फिर से पूरी प्रक्रिया में जाना होगा। और ऐसा लगता है कि सत्र स्वयं ही मारा जाता है (अगर मैं उस विंडो को बंद करता हूं जहां "विश्लेषण" बटन क्लिक किया गया था, तो कोड कम से कम चलता है, कम से कम उस मामले में मैं अनुरोध को मारने में सक्षम होना चाहता हूं। –

+0

I आश्चर्य कीजिए कि क्या आप 'विश्लेषण' के अंदर एक बूबी-जाल को एकीकृत कर सकते हैं जो एक निश्चित घटना (जैसे बटन प्रेस) के लिए सुनता है और कोड से तोड़ता है। –

+0

मुझे लगता है कि उदाहरण के लिए आप कुछ वैश्विक बूलियन ध्वज प्राप्त कर सकते हैं, और 'विश्लेषण' के अंदर समय-समय पर ध्वज की जांच करेगा। तो हाँ आप एक हैकी समाधान कर सकते हैं मानते हैं कि आपके पास जो भी कोड है, वह लंबी गणना कर रहा है।यदि आप किसी ऐसे फ़ंक्शन पर कॉल कर रहे हैं जो आपके द्वारा नहीं लिखा गया है, तो मुझे नहीं लगता कि आप यह कैसे कर सकते हैं –

उत्तर

2

बशर्ते आप कई भागों में भारी गणना विभाजित कर सकते हैं, या कोड है कि में शामिल है के भाग के लिए उपयोग किया गणना, आप एक ब्रेकर भाग डाल सकते हैं। मैंने इसे Shiny app में कार्यान्वित किया जो शेष गणना के साथ जारी रखने से पहले एक बटन प्रेस के लिए सुनता है। आप द्वारा

library(shiny) 
runGitHub("romunov/shinyapps", subdir = "breaker") 

या कॉपी आर से एप्लिकेशन को चला सकते हैं/एक server.R और ui.R में पेस्ट करते और runApp() का उपयोग कर इसे चलाते हैं।

#ui.R 
library(shiny) 

shinyUI(fluidPage(

    titlePanel("Interrupting calculation"), 

    sidebarLayout(
    sidebarPanel(
     sliderInput(inputId = "num.rows", 
        label = "Generate number of rows", 
        min = 1e1, 
        max = 1e7, 
        value = 3e3), 
     actionButton(inputId = "ok", label = "Stop computation") 
    ), 
    mainPanel(
     verbatimTextOutput("result") 
    ) 
) 
)) 

#server.R 
library(shiny) 

shinyServer(function(input, output) { 
    initial.ok <- 0 

    part1 <- reactive({ 
    nr.f <- floor(input$num.rows/2) 
    out1 <- data.frame(col = sample(letters[1:5], size = nr.f, 
            replace = TRUE), 
         val = runif(nr.f)) 
    out1 
    }) 

    part2 <- reactive({ 

    nr.c <- ceiling(input$num.rows/2) 
    out2 <- data.frame(col = sample(letters[1:5], size = nr.c, 
            replace = TRUE), 
         val = runif(nr.c)) 
    out2 
    }) 

    output$result <- renderPrint({ 

    out1 <- part1() 

    if (initial.ok < input$ok) { 
     initial.ok <<- initial.ok + 1 
     stop("Interrupted") 
    } 

    out2 <- part2() 
    out <- rbind(out1, out2) 

    print("Successful calculation") 
    print(str(out)) 
    }) 
}) 
1

httpuv :: सेवा() के बारे में क्या?

library(shiny) 
analyze <- function(session=shiny::getDefaultReactiveDomain()){ 
    continue = TRUE 
    lapply(1:100, function(x) { 
    if(continue){ 
     print(x) 
     Sys.sleep(1) 
     # reload inputs 
     httpuv:::service() 
     continue <<- !isTRUE(session$input$stopThis) 
    } 
    } 
) 
} 

shinyApp(
    ui = fluidPage(
    actionButton("start","Start",class="btn-primary", onclick="Shiny.onInputChange('stopThis',false)"), 
    actionButton("stop","Stop",class="btn-danger", onclick="Shiny.onInputChange('stopThis',true)") 
), 
    server = function(input, output, session) { 
    observeEvent(input$start, { 
     analyze() 
    }) 
    } 
) 
+0

धन्यवाद, लेकिन इस समाधान के साथ समस्या यह है कि यह केवल कुछ के पुनरावृत्तियों के बीच ही रोक सकता है। मैं एक ऐसे फ़ंक्शन को कॉल करने में सक्षम होना चाहता हूं जो लंबे समय तक लेता है, जिसके पास मेरे पास पहुंच नहीं है, इसलिए मैं इसके अंदर "ब्रेकपॉइंट्स" दर्ज नहीं कर सकता, और बस "ठीक है, कभी नहीं, उस फ़ंक्शन कॉल को रोकें ! " –

+0

हाँ। समझा। मुझे अभी एहसास हुआ कि मेरे पास बिल्कुल वही समस्या है। – fxi

4

तो एक और जवाब, एक लूप के बाहर: एक बच्चे की प्रक्रिया का उपयोग करें।

library(shiny) 
library(parallel) 

# 
# reactive variables 
# 
rVal <- reactiveValues() 
rVal$process <- NULL 
rVal$msg <- NULL 
rVal$obs <- NULL 
counter <- 0 
results <- list() 
dfEmpty <- data.frame(results = numeric(0)) 


# 
# Long computation 
# 
analyze <- function() { 
    out <- lapply(1:5, function(x) { 
    Sys.sleep(1) 
    rnorm(1) 
}) 
    data.frame(results = unlist(out)) 
} 

# 
# Shiny app 
# 
shinyApp(
    ui = fluidPage(
    column(6, 
     wellPanel(
     tags$label("Press start and wait 5 seconds for the process to finish"), 
     actionButton("start", "Start", class = "btn-primary"), 
     actionButton("stop", "Stop", class = "btn-danger"), 
     textOutput('msg'), 
     tableOutput('result') 
     ) 
    ), 
    column(6, 
     wellPanel(
     sliderInput(
      "inputTest", 
      "Shiny is responsive during computation", 
      min = 10, 
      max = 100, 
      value = 40 
     ), 
     plotOutput("testPlot") 
     ))), 
    server = function(input, output, session) 
    { 
    # 
    # Add something to play with during waiting 
    # 
    output$testPlot <- renderPlot({ 
     plot(rnorm(input$inputTest)) 
    }) 

    # 
    # Render messages 
    # 
    output$msg <- renderText({ 
     rVal$msg 
    }) 

    # 
    # Render results 
    # 
    output$result <- renderTable({ 
     print(rVal$result) 
     rVal$result 
    }) 

    # 
    # Start the process 
    # 
    observeEvent(input$start, { 
     if (!is.null(rVal$process)) 
     return() 
     rVal$result <- dfEmpty 
     rVal$process <- mcparallel({ 
     analyze() 
     }) 

     rVal$msg <- sprintf("%1$s started", rVal$process$pid) 

    }) 


    # 
    # Stop the process 
    # 
    observeEvent(input$stop, { 
     rVal$result <- dfEmpty 
     if (!is.null(rVal$process)) { 
     tools::pskill(rVal$process$pid) 
     rVal$msg <- sprintf("%1$s killed", rVal$process$pid) 
     rVal$process <- NULL 

     if (!is.null(rVal$obs)) { 
      rVal$obs$destroy() 
     } 
     } 
    }) 

    # 
    # Handle process event 
    # 
    observeEvent(rVal$process, { 
     rVal$obs <- observe({ 
     invalidateLater(500, session) 
     isolate({ 
     result <- mccollect(rVal$process, wait = FALSE) 
     if (!is.null(result)) { 
      rVal$result <- result 
      rVal$obs$destroy() 
      rVal$process <- NULL 
     } 
     }) 
     }) 
    }) 
    } 
) 

संपादित

यह भी देखें:

+0

मैं उस कोड को इस प्रकार नहीं चला सकता क्योंकि यह 'mcparallel' परिभाषित नहीं किया गया है (शायद मुझे' समानांतर 'पैकेज का एक नया संस्करण चाहिए? या यह एक अलग पैकेज से है?)। लेकिन मैं देखता हूं कि आप क्या कर रहे हैं, और हाँ मुझे लगता है कि यह काम करेगा। यह सबसे सुंदर समाधान नहीं है लेकिन यह अच्छा है कि आपने इसे यहां पोस्ट किया ताकि अगर किसी को ऐसा करने की ज़रूरत है, तो उन्हें एक तरह से पता चल जाएगा। धन्यवाद! –

+0

आर को सिंगल थ्रेडेड होने के साथ, अभी कोई दूसरा रास्ता नहीं है। मुझे लगता है। क्या आप विंडोज़ पर हैं? यह उस प्लेटफ़ॉर्म पर नहीं चलेगा: समांतर दस्तावेज़ देखें। आप एक प्रतिक्रियाशीलChildProcess() के लिए चमकदार टीम से पूछ सकते हैं। Haha। विंडोज़ पर – fxi

+0

हां। चमकदार उपयोगकर्ताओं के कई (सबसे?) हैं। यह एक बड़ा सौदा नहीं है, मुझे नहीं लगता कि इसे प्राथमिकता मिलेगी, मुझे इसके बारे में कोई समस्या दर्ज करने के लिए दबाया नहीं गया है ... लेकिन यह अच्छा है कि यह समाधान अब बाहर है –

0

शायद यह भी वास्तव में क्या आप देख रहे हैं नहीं है, लेकिन चाल कर सकता है (कम से कम एम पर ताकतवर लिनक्स)। मेरे लिए यह वैसे ही काम करता है जब मैं चाहता हूं क्योंकि मैं बैश स्क्रिप्ट का उपयोग करता हूं जो आर चमकदार द्वारा ट्रिगर किए जाते हैं और मैं उन्हें निरस्त करने में सक्षम होना चाहता हूं। तो अपने आर कोड को एक स्क्रिप्ट में डालने और सिस्टम कमांड द्वारा स्क्रिप्ट को ट्रिगर करने के बारे में कैसे?

नीचे दिए गए उदाहरण में मैं केवल एक साधारण डमी बैश स्क्रिप्ट का उपयोग करता हूं जो नींद कमांड चलाता है, जबकि पहला सीएल तर्क नींद की मात्रा है। 10 सेकंड से कम सब कुछ स्वीकार नहीं किया जाता है और बाहर निकलने की स्थिति को 1 तक रखता है। इसके अतिरिक्त, मुझे लॉगफाइल में कुछ आउटपुट मिलता है जिसे मैं मॉनीटर कर सकता हूं, और इस प्रकार रीयलटाइम में प्रगति करता हूं।

आशा है कि आपको यह सहायक लगेगा।

library(shiny) 

ui <- fluidPage(

# we need this to send costumized messages 
tags$head(tags$script(HTML('Shiny.addCustomMessageHandler("jsCode",function(message) {eval(message.value);});'))), 

# Sidebar with a slider input for number of bins 
sidebarLayout(
sidebarPanel(

    textInput("duration", "How long you want to wait?"),hr(), 
    p("Are you experienced?"), 
    actionButton("processbtn", "Yes"),hr(), 
    p("Show me what's going on"), 
    actionButton("logbtn", "Show me by clicking here."),hr(), 
    p("Tired of being experienced?"), 
    actionButton("abortbtn", "Yes") 

    ), # close sidebar panel 

    # Show a plot of the generated distribution 
    mainPanel(
    textOutput("outText"),hr(), 
    verbatimTextOutput("outLog") 
) # close mainpanel 
) # close sidebar 
) # close fluidpage 

#------SERVER------------ 

# Define server logic required to draw a histogram 
server <- function(input, output, session) { 

# our reactive values that change on button click by the observe functions below 
values <- reactiveValues(process = 0, abort = 0, log = 0) 

observeEvent(input$processbtn, { 
    values$process = 1 
    values$abort = 0 
    values$log = 0 
}) 

observeEvent(input$abortbtn, { 
    values$process = 0 
    values$abort = 1 
}) 

observeEvent(input$logbtn, { 
    values$log = 1 
}) 

current_state = function(exitfile) { 
# get the pid 
pid = as.integer(system2("ps", args = "-ef | grep \"bash ~/dummy_script.sh\" | grep -v grep | awk '{print $2}'", stdout = TRUE)) 
print(pid) 

if (length(pid) > 0) 
return("RUNNING") 

if (file.exists(exitfile)) 
return("TERMINATED") 

return("NOT_STARTED") 
} 

start_function = function(exitfile) { 
if(input$duration == "") { 
    end_message="The text input field is empty!" 
    js_string <- 'alert("SUCCESS");' 
    js_string <- sub("SUCCESS",end_message,js_string) 
    session$sendCustomMessage(type='jsCode', list(value = js_string)) 
    values$process = 0 
    return("NOT_STARTED") 

} else { # all checks are fine. send a message and start processing 
    end_message="We start waiting, yeah!!!" 
    js_string <- 'alert("SUCCESS");' 
    js_string <- sub("SUCCESS",end_message,js_string) 
    session$sendCustomMessage(type='jsCode', list(value = js_string)) 

# here we execute the outsourced script and 
# write the exit status to a file, so we can check for that and give an error message 
system(paste("(bash ~/dummy_script.sh", input$duration,"; echo $? >", exitfile, ")"), wait = FALSE) 
return("RUNNING") 
} 
} 

on_terminated = function(exitfile) { 
    # get the exit state of the script 
    status = readLines(exitfile) 
    print(status) 
    # we want to remove the exit file for the next run 
    unlink(exitfile, force = TRUE) 

    # message when we finished 
    if (status != 0){ 
    end_message="Duration is too short." 
    js_string <- 'alert("SUCCESS");' 
    js_string <- sub("SUCCESS",end_message,js_string) 
    session$sendCustomMessage(type='jsCode', list(value = js_string)) 
    } 
    else { 
    end_message="Success" 
    js_string <- 'alert("SUCCESS");' 
    js_string <- sub("SUCCESS",end_message,js_string) 
    session$sendCustomMessage(type='jsCode', list(value = js_string)) 
    } 
    values$process = 0 
} 

# our main processing fucntion 
output$outText = renderText({ 
    # trigger processing when action button clicked 
    if(values$process) { 

    # get the homefolder 
    homedir=Sys.getenv("HOME") 

    # create the path for an exit file (we'll need to evaluate the end of the script) 
    exitfile=file.path(homedir, "dummy_exit") 
    print(exitfile) 

    state = current_state(exitfile) # Can be NOT_STARTED, RUNNING, COMPLETED 
    print(state) 
    if (state == "NOT_STARTED") 
     state = start_function(exitfile) 

    if (state == "RUNNING") 
     invalidateLater(2000, session = getDefaultReactiveDomain()) 

    if (state == "TERMINATED") 
     on_terminated(exitfile) 



    # Abort processing 
    } else 
    if(values$abort) { 
     pid = as.integer(system2("ps", args = "-ef | grep \"bash ~/dummy_script.sh\" | grep -v grep | awk '{print $2}'", stdout = TRUE)) 
    print(pid) 
    system(paste("kill", pid), wait = FALSE) 
    } 

}) # close renderText function 

output$outLog = renderText({ 

if(values$log) { 

    homedir=Sys.getenv("HOME") 
    logfile=file.path(homedir, "/dummy_log") 

if(file.exists(logfile)){ 
    invalidateLater(2000) 
    paste(readLines(logfile), collapse = "\n") 
} 
else { 
    print("Nothing going on here") 
} 
} 

}) 


} # close server 

# Run the application 
shinyApp(ui = ui, server = server) 
संबंधित मुद्दे