Использование Shiny App для динамической визуализации каждой итерации замены строк? - PullRequest
Новая
       9

Использование Shiny App для динамической визуализации каждой итерации замены строк?

0 голосов
/ 22 апреля 2019

Я хотел бы изменить ввод и отобразить вывод некоторого кода 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 с использованием интерфейса вставки и actionButton.

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

Буду очень признателен за любые советы относительно того, возможно ли это в Shiny или мне нужен другой инструмент.

1 Ответ

1 голос
/ 22 апреля 2019 
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. Возьмите значение счетчика для подмножества вашего окончательного набора данных.

...