Блог

Я хотел бы изменить ввод и отобразить вывод некоторого 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), определяемые пользователем. Я знаю, что это возможно в Shiny, используя insert UI и actionButton .

Я менее уверен, есть ли способ динамического отображения выходных данных, чтобы пользователь мог визуально видеть каждую итерацию кода (с определенной временной задержкой между каждой итерацией?) вместо того, чтобы видеть все итерации, выводимые сразу, как это происходит с существующим кодом. Я открыт для различных способов динамической визуализации выходных данных, но я думаю, что в идеале пользователь будет видеть, как каждая итерация заменяется следующей с задержкой по времени. Мне также нужна вкладка с текущим выводом, каждая итерация представляет собой строку, чтобы пользователь мог вернуться и просмотреть каждую итерацию.

Буду признателен за любые советы о том, возможно ли это в 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)
  

Как насчет этого? Для отображения таблицы мы можем установить reactiveValue , которая обновляется после запуска функции i nvalidateLater . Возьмите значение счетчика для подмножества вашего конечного набора данных.