Question

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

我希望将其呈现为Shiny应用程序，其中用户可以指定输入文本和不同类型的更改的可能性。对于后者，用户可以指定（runif（1）> 0.5）和（runif（1）> 0.9）中的值。我知道使用插入UI和actionButton在Shiny中是可能的。

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

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

Answer 1

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)

这个怎么样？要渲染该表，我们可以设置一个reactiveValue，该函数在i nvalidateLater函数触发后会更新。取计数器的值作为最终数据集的子集。

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

1 个答案: