时间戳

首页 > 解决方案 > 使用 Shiny App 动态可视化字符串替换的每次迭代？

r - 使用 Shiny App 动态可视化字符串替换的每次迭代？

问题描述

我想修改输入并以更具交互性的方式显示一些 R 代码的输出。我认为这对于 Shiny 应用程序来说是一个理想的任务，但我对编写它们不是很熟悉。我有一些 R 代码，它接受一串文本并通过在随机位置添加字母或单词来迭代地更改它：

library(tidyverse)

evolve_sentence <- function(sentence, arg2) {
  chars <- str_split(sentence, "") %>% pluck(1)
  if (runif(1) > 0.5) {
    chars[sample(1:length(chars), 1)] <- sample(chars, 1)
  }
  sentence <- str_c(chars, collapse = "")
  words <- str_split(sentence, " ") %>% pluck(1)
  if (runif(1) > 0.9) {
    words[sample(1:length(words), 1)] <- sample(words, 1)
  }
  sentence <- str_c(words, collapse = " ")
  sentence
}

tbl_evolve <- tibble(iteration = 1:500, text = "I met a traveller from an antique land")
for (i in 2:500) {
  tbl_evolve$text[i] <- evolve_sentence(tbl_evolve$text[i - 1])
}
tbl_evolve %>%
  distinct(text, .keep_all = TRUE)

输出如下所示：

1   I met a traveller from an antique land          
2   I met a tIaveller from an antique land          
4   I met a tIaveller from an antique lanr          
5   I met a tIaveller from an fntique lanr          
6   I met a tIaveller fromnan met lanr

我很乐意将其呈现为一个闪亮的应用程序，其中输入文本和不同类型更改的概率可以由用户指定。对于后者，这将使用户可以指定 (runif(1) > 0.5) 和 (runif(1) > 0.9) 中的值。我知道在 Shiny 中使用插入 UI 和actionButton.

我不太确定是否有一种方法可以动态显示输出，以便用户可以直观地看到代码的每次迭代（每次迭代之间有定义的时间延迟？），而不是像一次看到所有迭代输出一样现有的代码。我对动态可视化输出的不同方式持开放态度，但我认为理想情况下，用户会看到每次迭代都被下一个迭代所取代，但会有时间延迟。我还想要一个带有当前输出的选项卡，每次迭代都是一行，因此用户可以返回并查看每次迭代。

任何关于这在 Shiny 中是否可行或者我是否需要不同工具的建议将不胜感激。

标签： rstringshinyshiny-reactivity

解决方案

library(shiny)
library(tidyverse)


# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("Simple Testcase"),

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
            textInput("textinput", "Type text here"),
            numericInput("p1", "Probability1", value = 0.5),
            numericInput("p2", "Probability2", value = 0.9),
            sliderInput("iteration", "Iterations", min = 20, max = 1000, step = 10, value = 100),
            actionButton("calc", "Run Calculation!")
        ),
        # Show a plot of the generated distribution
        mainPanel(
           tableOutput("ui")
        )
    )
)

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

    vals <- reactiveValues(counter = 0)


    result <- eventReactive(input$calc, {



        evolve_sentence <- function(sentence, arg2) {
            chars <- str_split(sentence, "") %>% pluck(1)
            if (runif(1) > input$p1) { # Value from numericinput p2
                chars[sample(1:length(chars), 1)] <- sample(chars, 1)
            }
            sentence <- str_c(chars, collapse = "")
            words <- str_split(sentence, " ") %>% pluck(1)
            if (runif(1) > input$p2) { # Value from numericinput p2
                words[sample(1:length(words), 1)] <- sample(words, 1)
            }
            sentence <- str_c(words, collapse = " ")
            sentence
        }

        tbl_evolve <- tibble(iteration = 1:500, text = input$textinput)
        for (i in 2:500) {
            tbl_evolve$text[i] <- evolve_sentence(tbl_evolve$text[i - 1])
        }
        output <-tbl_evolve %>%
            distinct(text, .keep_all = TRUE)
        print(output)
        output


    })


    output$ui <- renderTable({

        df <- result()

        invalidateLater(millis = 300, session)
        vals$counter <- isolate(vals$counter) + 1

    while(nrow(df) < vals$counter) {
        vals$counter <- isolate(vals$counter) + 1
    } #Prevent to add infinite empty columns.

       for(i in 1:nrow(df)) {
           newdf <- df[1:vals$counter,]
       }

       newdf

    })

}

# Run the application 
shinyApp(ui = ui, server = server)

这个怎么样？要渲染表格，我们可以设置 a reactiveValue，它会在 invalidateLater函数触发后更新。将计数器的值作为最终数据集的子集。

推荐阅读