From 1c2d5ff5b3a4f195b61841ea7c2efe0dd5c240eb Mon Sep 17 00:00:00 2001 From: GwenAnderson <62318153+GwenAnderson@users.noreply.github.com> Date: Fri, 2 Apr 2021 13:05:57 -0700 Subject: [PATCH] Create GA_Example1_Reactivity # Vocabulary Quiz Text String Example of Reactivity # Solution not found in Chapters 3, 13, 15 of Mastering Shiny. # It is unclear how to use a reactiveVal() within observeEvent() or with code for a text string (only integers are shown in text). --- GA_Example1_Reactivity | 201 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 201 insertions(+) create mode 100644 GA_Example1_Reactivity diff --git a/GA_Example1_Reactivity b/GA_Example1_Reactivity new file mode 100644 index 00000000..a2e1e5b2 --- /dev/null +++ b/GA_Example1_Reactivity @@ -0,0 +1,201 @@ +# Vocabulary Quiz Text String Example of Reactivity +# Solution not found in Chapters 3, 13, 15 of Mastering Shiny. + + #--------------------------------------------------------------------------------------------------------------------------------------------------- + # Version One - the word does not update in renderText because NextWord is not defined as a reactive value. The message shows the word is changing. + #--------------------------------------------------------------------------------------------------------------------------------------------------- +library(shiny) + +# Example Vocabulary List +Word = c( 'advocate', 'antipathy', 'audacious', 'bolster', 'cacophony', 'corroborate', 'deride', 'desiccate', + 'dissonance', 'ephemeral', 'equivocal', 'erudite', 'fervid', 'garrulous', 'homogenous','ingenuous', + 'laconic', 'laudable', 'lethargic', 'lucid', 'malleable','misanthrope', 'ostentation', 'prodigal', 'venerate') + + # Length of word list for random word selection + numwords <- length(Word) + + # Sample one quiz word randomly + NextWord <- Word[sample(seq(1:numwords), size = 1)] + + # Simplified app outputs the random quiz words only (without definition choices) + ui <- fluidPage( + fluidRow(column(12, + br(), + h4("Vocabulary Word:"), + em(h2(textOutput("Vocabulary_Word"))), + h4(""), + ), + ), + br(), + fluidRow(column(8, + actionButton("Next", "<<< BEGIN VOCABULARY QUIZ >>>", class = "btn-block") + ) + ) + ) + + server <- function(input, output, session) { + + observeEvent(input$Next, { + NextWord <- Word[sample(seq(1:numwords), size = 1)] + message(NextWord) + updateActionButton(inputId = "Next", label = " >>> Next Word >>> ") + }) + + output$Vocabulary_Word <- renderText({ + NextWord + }) +} + + shinyApp(ui, server) + + #---------------------------------------------------------------------------------------------------------------- + # Version Two server - the random word is a reactive so new quiz words appear when the Next button is clicked + #---------------------------------------------------------------------------------------------------------------- + + server <- function(input, output, session) { + + observeEvent(input$Next, { + updateActionButton(inputId = "Next", label = " >>> Next Word >>> ") + }) + + NextWord <- eventReactive(input$Next, { + Word[sample(seq(1:numwords), size = 1)] + }) + + output$Vocabulary_Word <- renderText({ + NextWord() + }) + } + + #--------------------------------------------------------------------------------------------------------------------------------- + # Version Three - quiz with answer choices - following framework of version 2, the code runs fine but its structure is convoluted + #--------------------------------------------------------------------------------------------------------------------------------- + + library(shiny) + library(data.table) + library(dplyr) + + VocabList <- as.data.table(data.frame( + Word = c( 'advocate', 'antipathy', 'audacious', 'bolster', 'cacophony', 'corroborate', 'deride', 'desiccate', + 'dissonance', 'ephemeral', 'equivocal', 'erudite', 'fervid', 'garrulous', 'homogenous','ingenuous', + 'laconic', 'laudable', 'lethargic', 'lucid', 'malleable','misanthrope', 'ostentation', 'prodigal', 'venerate'), + + Definition = c( + 'publicly recommend or support', + 'a strong feeling of dislike', + 'a willingness to take bold risks', + 'to support or strengthen', + 'a harsh, unpleasant mixture of sounds', + 'to confirm or make more certain', + 'to express contempt for', + 'remove the moisture from', + 'a lack of harmony or agreement', + 'lasting for a very short time', + 'not easily understood or explained', + 'having or showing great knowledge', + 'intensely enthusiastic', + 'excessively talkative', + 'of the same or similar kind', + 'innocent and unsuspecting', + 'using few words', + 'deserving praise and commendation', + 'lacking energy', + 'very clear and easy to understand', + 'easily influenced; pliable', + 'a person who dislikes humankind', + 'excessive display of wealth', + 'wastefully extravagant', + 'regard with great respect') + )) + + # Label the data frame rows with Key/Index 'Entry' + VocabList$Entry <- as.integer(row.names(VocabList)) + VocabList + + # Length of word list for random word selection + numwords <- nrow(VocabList) + + # Sample one quiz word randomly + NextWord <- VocabList$Word[sample(seq(1:numwords), size = 1)] + + # Begin with a blank app until the "Begin/Next" button is clicked. + ui <- fluidPage( + fluidRow(column(12, + br(), + h4("Vocabulary Word:"), + em(h2(textOutput("Vocabulary_Word"))), + h4(""), + ), + ), + br(), + +fluidRow(column(12, + radioButtons("definition", "Choose the closest definition.",choices = c('A', 'B', 'C', 'D'), width = '100%', selected = character(0)) +), +), + fluidRow(column(8, + actionButton("Next", "<<< BEGIN VOCABULARY QUIZ >>>", class = "btn-block") + ) + ) + ) + + # NextEntry (the new word with definition) and NextRands (four random definition choices) are eventReactive to the Next button. + + server <- function(input, output, session) { + + NextEntry <- eventReactive(input$Next, { + sample(seq(1:numwords), size = 1) + }) + + NextRands <- eventReactive(input$Next, { + sample(seq(1:numwords), size = 4, replace = FALSE) + }) + + # If the new word is not one of the four random words, then one of the four is replaced. + observeEvent(input$Next, { + randlistfour <- filter(VocabList, Entry %in% NextRands()) + randwordpick <- ceiling(4*runif(1)) + if(!(NextEntry() %in% randlistfour$Entry)){ + randlistfour[randwordpick, ] <- filter(VocabList, Entry == NextEntry()) + } + updateRadioButtons(inputId = "definition", label = "Choose the closest definition.", choices = randlistfour$Definition, selected = character(0)) + updateActionButton(inputId = "Next", label = " >>> Next Word >>> ") + }) + + output$Vocabulary_Word <- renderText({ + VocabList$Word[NextEntry()] + }) + } + + shinyApp(ui, server) + + + #------------------------------------------------------------------------------------------------------------------------ + # Version Four server - updated from Version Three - code is streamlined but again the vocabulary word does not change + #------------------------------------------------------------------------------------------------------------------------ + + # Set NextWord() randomly as a reactiveVal() before the ui. + NextWord <- reactiveVal(VocabList[ceiling(numwords*runif(1)),]$Word) + + server <- function(input, output, session) { + + # Update the NextWord() reactiveVal() within observEvent() when the Next button is clicked. + observeEvent(input$Next, { + randlistfour <- VocabList[sample(seq(1:numwords), size = 4, replace = FALSE)] + randwordpick <- ceiling(4*runif(1)) + NextWord <- reactiveVal( randlistfour[randwordpick,]$Word ) + message(randlistfour[randwordpick,]$Word) + updateRadioButtons(inputId = "definition", label = "Choose the closest definition.", choices = randlistfour$Definition, selected = character(0)) + updateActionButton(inputId = "Next", label = " >>> Next Word >>> ") + }) + + output$Vocabulary_Word <- renderText({ + NextWord() + }) + } + + shinyApp(ui, server) + + + +