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

Using Shiny App to dynamically visualise each iteration of string replacement?

我想修改输入并以更具交互性的方式显示一些 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 是可能的。

我不太确定是否有动态显示输出的方法,以便用户可以直观地看到代码的每次迭代(每次迭代之间有定义的时间延迟?)而不是看到所有迭代输出once as once 对现有代码进行处理。我对动态可视化输出的不同方式持开放态度,但我认为理想情况下,用户会看到每次迭代都被下一次迭代替换,但有时间延迟。 我还想要一个包含当前输出的选项卡,每次迭代都是一行,因此用户可以返回并查看每次迭代。

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

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)

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