更新进入循环闪亮

时间:2017-07-10 08:58:08

标签: r shiny rstudio

我设计了一个闪亮的应用程序来更改绘图y的限制,以便可视化我的数据(地质时间序列,y是深度/时间和x任何参数),以我想要的y值为中心。在界面中,我有不同的输入类型在y中导航,例如向上和向下按钮和滑块。如果我使用按钮,此滑块将自动更新。但是,如果我点击太快或者我更快地更改滑块(即在绘图刷新之前),应用程序将进入循环并在两个y值之间振荡。

我尝试在不同的位置使用isolate()但没有成功,也找不到如何解决这个bug。

提前感谢您的帮助: - )

以下是一个示例,快速单击按钮以显示错误;

library(shiny)

ymax <- 100
ymin <- 0


ui <- fluidPage(
  sidebarPanel(

    h3("See"),

    numericInput("yinter", "Vertical interval (m)",
                 min = 0, max = ymax, value = 50, step = 0.5),

    numericInput("movepercent", "Scroll interval (%)",
                 min = 0, max = 100, value = 15, step = 5),

    numericInput("heightNumeric", "Height (m)",
                 min = ymin, max = ymax, value = ymin, step = 1),

    sliderInput("heightSlider","Height (m)",min = ymin, max = ymax, 
                value = ymin,step=0.01),

    actionButton("up","",icon("arrow-up"),
                 width = "100%"),

    actionButton("down","",icon("arrow-down"),
                 width = "100%",""),


    width=2
  ),

  sidebarPanel(
    plotOutput("plot1",height = 800)
  )

)


server <- function(input, output, clientData, session) {


  values <- reactiveValues()

  values$i <- 0

  observeEvent(input$up, {
    values$i <- values$i + input$yinter*(input$movepercent/100)
  })

  observeEvent(input$down, {
    values$i <- values$i - input$yinter*(input$movepercent/100)
  })

  observeEvent(input$heightSlider, {
    values$i <- input$heightSlider
  })

  observeEvent(input$heightNumeric, {
    values$i <- input$heightNumeric
  })

  observe({
    updateNumericInput(session,"heightNumeric",value = values$i)
  })

  observe({
    updateSliderInput(session,"heightSlider",value = values$i)
  })

  output$plot1 <- renderPlot({
    plot(seq(from=0,to=1,by=0.0001),seq(from=0,to=100,by=0.01),
         type="l",ylim=c(values$i-input$yinter/2,
                         values$i+input$yinter/2))
  })

}


shinyApp(ui = ui, server = server)

4 个答案:

答案 0 :(得分:1)

这应该有效:

library(shiny)

ymax <- 100
ymin <- 0


ui <- fluidPage(
  sidebarPanel(

    h3("See"),

    numericInput("yinter", "Vertical interval (m)",
                 min = 0, max = ymax, value = 50, step = 0.5),

    numericInput("movepercent", "Scroll interval (%)",
                 min = 0, max = 100, value = 15, step = 5),

    uiOutput("inputs"),

    actionButton("up","",icon("arrow-up"),
                 width = "100%"),

    actionButton("down","",icon("arrow-down"),
                 width = "100%",""),


    width=2
  ),

  sidebarPanel(
    plotOutput("plot1",height = 800)
  )

)


server <- function(input, output, clientData, session) {


  ival <- reactiveVal(0)

  observeEvent(input$up, {
    newval <- ival() + input$yinter*(input$movepercent/100)
    ival(newval)
  })

  observeEvent(input$down, {
    newval <- ival() - input$yinter*(input$movepercent/100)
    ival(newval)
  })

  observeEvent(input$heightSlider, {
  if(input$heightNumeric != input$heightSlider){
    ival(input$heightSlider)
  }
  })

  observeEvent(input$heightNumeric, {
  if(input$heightNumeric != input$heightSlider){
    ival(input$heightNumeric)
  }
  })

  output$inputs <- renderUI({
    newval <- ival()
    tagList(
      numericInput("heightNumeric", "Height (m)",
                   min = ymin, max = ymax, value = newval, step = 1),

      sliderInput("heightSlider","Height (m)",min = ymin, max = ymax, 
                  value = newval ,step=0.01)

    )
  })

  output$plot1 <- renderPlot({
    plot(seq(from=0,to=1,by=0.0001),seq(from=0,to=100,by=0.01),
         type="l",ylim=c(ival() - input$yinter/2,
                         ival() + input$yinter/2))
  })
}

shinyApp(ui = ui, server = server)

答案 1 :(得分:0)

您可以尝试隔离高度滑块和高度数字,并使其响应操作按钮上的点击次数:

import java.util.concurrent.TimeUnit;

import org.openqa.selenium.By;
import org.openqa.selenium.WebDriver;
import org.openqa.selenium.WebElement;
import org.openqa.selenium.firefox.FirefoxDriver;

public class Q44732783_Naukri {

    public static void main(String[] args) throws InterruptedException 
    {


        System.setProperty("webdriver.gecko.driver", "C:\\Utility\\BrowserDrivers\\geckodriver.exe");
        WebDriver driver=new FirefoxDriver();
        driver.get("https://www.naukri.com/");
        driver.manage().timeouts().implicitlyWait(5, TimeUnit.SECONDS);
        driver.findElement(By.xpath("//div[text()='Login']")).click();
        driver.findElement(By.id("eLogin")).sendKeys("unix.dev.qa@gmail.com");
        driver.findElement(By.id("pLogin")).sendKeys("iamthebest");
        driver.findElement(By.xpath("//button[text()='Login']")).click();
        WebElement myelement = driver.findElement(By.xpath("//div[@id='leftNav_updateProfile']//a[contains(.,' Attached Resume') and not(@class='gryTxt')]"));
        myelement.click();

    }

}

答案 2 :(得分:0)

您不需要隔离任何内容,但您必须删除应用程序中的循环依赖项。现在,您确实可以最终振荡,因为所有更新都是独立发生的。因此,如果在更新所有内容之前两个输入更改values$i,那么您将会看到这些值之间的连续振荡。

最简单的解决方案是仅更新每个观察者内部需要更新的内容。因此,当触摸滑块时,立即更新numericInput。触摸数字输入后,立即更新sliderInput。按下任何按钮时,同时更新两个按钮。

这为您提供以下服务器功能。你可以尝试你想要的东西,因为更新都是在一个表达式中完成的,所有内容都会在光亮评估链中的下一个反应之前更新。

server <- function(input, output, clientData, session) {


  values <- reactiveValues()

  values$i <- 0

  observeEvent(input$up, {
    values$i <- values$i + input$yinter*(input$movepercent/100)
    updateNumericInput(session,"heightNumeric",value = values$i)
    updateSliderInput(session,"heightSlider",value = values$i)
  })

  observeEvent(input$down, {
    values$i <- values$i - input$yinter*(input$movepercent/100)
    updateNumericInput(session,"heightNumeric",value = values$i)
    updateSliderInput(session,"heightSlider",value = values$i)
  })

  observeEvent(input$heightSlider, {
    values$i <- input$heightSlider
    updateNumericInput(session,"heightNumeric",value = values$i)
  })

  observeEvent(input$heightNumeric, {
    values$i <- input$heightNumeric
    updateSliderInput(session,"heightSlider",value = values$i)
  })

  output$plot1 <- renderPlot({
    plot(seq(from=0,to=1,by=0.0001),seq(from=0,to=100,by=0.01),
         type="l",ylim=c(values$i-input$yinter/2,
                         values$i+input$yinter/2))
  })

}

答案 3 :(得分:0)

我完全错了。问题确实是数字和滑块输入的异步更新。更确切地说,更新函数(updateSliderInput resp updateNumericInput)不会立即更新滑块。只有在运行所有其他观察者之后,才会将这些更新发送到客户端。

现在假设你更新了滑块。 observeEvent更新ival()。这会触发observer()更新两个输入。但是,如果在将这些更新发送到客户端之前按下up按钮,ival会在发送旧值以更新输入之前更改为新值。该旧值会更改input$sliderInput,从而再次触发observeEvent()并开始新的循环。这就是我相信你的振荡的原因。

要解决此问题,您需要在服务器端重新生成输入,而不是在客户端更新它。或者你可以避免使用4种不同的输入来完全相同的事情......

因此,您的示例应用程序变为:

library(shiny)

ymax <- 100
ymin <- 0


ui <- fluidPage(
  sidebarPanel(

    h3("See"),

    numericInput("yinter", "Vertical interval (m)",
                 min = 0, max = ymax, value = 50, step = 0.5),

    numericInput("movepercent", "Scroll interval (%)",
                 min = 0, max = 100, value = 15, step = 5),

    uiOutput("inputs"),

    actionButton("up","",icon("arrow-up"),
                 width = "100%"),

    actionButton("down","",icon("arrow-down"),
                 width = "100%",""),


    width=2
  ),

  sidebarPanel(
    plotOutput("plot1",height = 800)
  )

)


server <- function(input, output, clientData, session) {


  ival <- reactiveVal(0)

  observeEvent(input$up, {
    newval <- ival() + input$yinter*(input$movepercent/100)
    ival(newval)
  })

  observeEvent(input$down, {
    newval <- ival() - input$yinter*(input$movepercent/100)
    ival(newval)
  })

  observeEvent(input$heightSlider, {
    ival(input$heightSlider)
  })

  observeEvent(input$heightNumeric, {
    ival(input$heightNumeric)
  })

  output$inputs <- renderUI({
    newval <- ival()
    tagList(
      numericInput("heightNumeric", "Height (m)",
                   min = ymin, max = ymax, value = newval, step = 1),

      sliderInput("heightSlider","Height (m)",min = ymin, max = ymax, 
                  value = newval ,step=0.01)

    )
  })

  output$plot1 <- renderPlot({
    plot(seq(from=0,to=1,by=0.0001),seq(from=0,to=100,by=0.01),
         type="l",ylim=c(ival() - input$yinter/2,
                         ival() + input$yinter/2))
  })
}

shinyApp(ui = ui, server = server)