swipr not displaying first reactive quote after tabpanel activated from actionButton

[julesbernard]

I have a small shiny app where on tabpanel2 the shinyswipr module displays quotes pulled from a dataframe at random. tabpanel1 contains actionButtons corresponding to columns of the dataframe with each column containing quotes from different writers.

Once the actionbutton is pressed, a quote is selected properly (I can see from the browser that the reactivevalue is updated), and if I simply render the text on panel2 outside of the shinyswipr module the text displays just fine. However, the shinyswipr module doesn't show the first quote (just appears blank), once the first card is swiped away, the second quote appears as expected.

Any ideas why this is happening? As a workaround, is it possible to call the shinyswipr module to swipe away the first card after the actionButton press?

[nstrayer]

Hi Jules! So sorry for the delay. Just getting caught up after the holidays. That's an interesting bug. Did you try out the demo app for shinyswipr (shinysense::run_demo('shinyviewr'))? It seems to do very similar things. That being said it may be tabpanel2 that is messing stuff up. Any possibility to get the code for the app or a minimal example that recreates the problem so I can dig into debugging it?

Best, Nick

[julesbernard]

Hi Nick, No worries at all. I used the demo app as the base of my project. I do think that the problem has something to do with the cards being inactive in tab2 while the app opens in tab1. I'm happy to share my code, should I just upload the project to GitHub? Paste the code?

[nstrayer]

It may be. I have built an app before that has multiple tabs with the swipr that still worked but there may be something else going on due to new versions of the various packages. I'd say a copy and paste of a single file shiny app would be best in this issue thread, or both the server and ui files if it's not easy to combine them.

[julesbernard]

Hi Nick,

Here is my code. I also uploaded the working app to https://jules-bernard.shinyapps.io/greetingproject/. You'll notice that if any category other than 'Encouragement Messages' (the default) is selected from tab 1, the card will appear blank after the switch to tab 2.

--

#Greeting Message Project
#2019-12-26 version

library(shinysense)
library(shinythemes)
library(shiny)
library(fortunes)
library(tidyverse)
library(here)

options(digits.secs=3)
options(shiny.port= 4020)
options(shiny.host = "0.0.0.0")
master.Swipes <- data.frame()

# handles category names for dropdown
selections <- colnames(Encouragement.Messages)
selections.Names <- setNames(selections, selections %>% gsub("\\.", " ", .) %>% gsub(' $', '', .))

# ui <- fixedPage(
ui <- fluidPage(theme = shinytheme("yeti"),
                mainPanel(h1("What to Write"),
                          # Output: 
                          tabsetPanel(type = "tabs", id='inTabset',
                                      #Category Panel
                                      tabPanel("Categories", value="panel1",

                                               fluidRow(column(12,
                                                               # shinythemes::themeSelector(),
                                                               actionButton('btn.Valentines', label="Valentines Messages", width='100%', class="btn-primary btn-lg", style="border-color: #ffffff"),
                                                               actionButton('btn.Enc.Messages', label="Encouragement Messages", width='100%', class="btn-secondary btn-lg", style="border-color: #ffffff"),
                                                               actionButton('btn.Bby.Shower', label="Baby Shower Wishes", width='100%', class="btn-primary btn-lg", style="border-color: #ffffff"),
                                                               actionButton('btn.Xms.Wishes', label="Christmas Wishes", width='100%', class="btn-secondary btn-lg", style="border-color: #ffffff"),
                                                               actionButton('btn.Rtrmt.Messages', label="Retirement Messages", width='100%', class="btn-primary btn-lg", style="border-color: #ffffff"),
                                                               actionButton('btn.Bridal.Messages', label="Bridal Shower Messages", width='100%', class="btn-secondary btn-lg", style="border-color: #ffffff"),
                                                               actionButton('btn.Thanks.Messages', label="Thank You Messages", width='100%', class="btn-primary btn-lg", style="border-color: #ffffff"),
                                                               actionButton('btn.Birthday.Wishes', label="Birthday Wishes", width='100%', class="btn-secondary btn-lg", style="border-color: #ffffff"),
                                               ),
                                               )),

                                      #Suggestion Panel
                                      tabPanel("Suggestions", value="panel2",
                                               hr(),
                                               h4("Swipe right to save, left for another"),
                                               hr(),
                                               shinyswipr_UI("quote_swiper",
                                                             h4("Say this:", align="center"),
                                                             hr(),
                                                             # tags$strong(textOutput("quote"))
                                                             shiny::tags$strong(textOutput("quote")),
                                                             class="text-white bg-secondary mb-3"
                                                             # h4("Author(s):"),
                                                             # textOutput("quote_author")
                                               ),
                                               hr(),
                                               #back button
                                               actionButton('btn.back.p1', label="Back", width='100%', class="btn-primary btn-lg", style="border-color: #ffffff"),
                                               hr(),
                                               # #debug browser button
                                               # actionButton("browser", "debug"),

                                               selectInput("messageCategory.selector", "Message Type", selections.Names,selected = (selections.Names[1])),
                                               hr(),
                                               h4("Top Picks"),
                                               tableOutput("resultsTable"))
                          )

                ))

################### -SERVER- ####################
server <- function(input, output, session) {

#save lines by making function to update dropdown message categories

    update.selectinput <- function() {
        #updates the dropdowns for select box
        appVals$selections.Names = setNames(
            colnames(appVals$selected.DF), 
            colnames(appVals$selected.DF) %>% 
                gsub("\\.", " ", .) %>% 
                gsub(' $', '', .))
        #updates the text of the select box
        updateSelectInput(
            session, 
            "messageCategory.selector", 
            "Message Type", 
            appVals$selections.Names, 
            selected        = (appVals$selections.Names[1]))
        #updates the quote box
        appVals$quote <- appVals$selected.DF[[input$messageCategory.selector]][sample(1:length(na.omit(appVals$selected.DF[[input$messageCategory.selector]])), 1, replace=FALSE)]
        output$quote <- renderText({ appVals$quote })
    }

    #### -- Back Button to Panel1 -- ####
    observeEvent(input$btn.back.p1, {
        updateTabsetPanel(session, "inTabset",
                          #moves to 2nd panel
                          selected              = "panel1")
    })
    #### -- Landing Page Buttons -- ###
    #Valentines
    observeEvent(input$btn.Valentines, {
        updateTabsetPanel(session, "inTabset",
                          #moves to 2nd panel
                          selected              = "panel2")
        #updates the selected Event DF
        appVals$selected.DF = Valentine.messages
        #updates the dropdowns for select box
        update.selectinput()

    })
    #Encouragement Messages
    observeEvent(input$btn.Enc.Messages, {
        updateTabsetPanel(session, "inTabset",
                          #moves to 2nd panel
                          selected              = "panel2")
        #updates the selected Event DF
        appVals$selected.DF = Encouragement.Messages
        #updates the dropdowns for select box
        update.selectinput()
    })

    observeEvent(input$btn.Bby.Shower, {
        updateTabsetPanel(session, "inTabset",
                          #moves to 2nd panel
                          selected              = "panel2")
        #updates the selected Event DF
        appVals$selected.DF = Baby.Shower.Wishes

    })

    observeEvent(input$btn.Xms.Wishes, {
        updateTabsetPanel(session, "inTabset",
                          selected = "panel2")

        #updates the selected Event DF
        appVals$selected.DF = Christmas.wishes
        #updates the dropdowns for select box
        update.selectinput()

    })

    observeEvent(input$btn.Rtrmt.Messages, {
        updateTabsetPanel(session, "inTabset",
                          selected = "panel2")

        #updates the selected Event DF
        appVals$selected.DF = Retirement.Messages
        #updates the dropdowns for select box
        update.selectinput()
    })

    observeEvent(input$btn.Bridal.Messages, {
        updateTabsetPanel(session, "inTabset",
                          selected = "panel2")

        #updates the selected Event DF
        appVals$selected.DF = Bridal.Shower.Wishes
        #updates the dropdowns for select box
        update.selectinput()
    })

    observeEvent(input$btn.Thanks.Messages, {
        updateTabsetPanel(session, "inTabset",
                          selected = "panel2")

        #updates the selected Event DF
        appVals$selected.DF = `Thank-You.Messages`
        #updates the dropdowns for select box
        update.selectinput()
    })

    observeEvent(input$btn.Birthday.Wishes, {
        updateTabsetPanel(session, "inTabset",
                          selected = "panel2")

        #updates the selected Event DF
        appVals$selected.DF = `Birthday.wishes`
        #updates the dropdowns for select box
        update.selectinput()
    })

    ##### #Calls the Shiny swipe module #####
    card_swipe <- callModule(shinyswipr, "quote_swiper")

    #these three vars handle writing the CSV log of user selections to disk 
    filedate <- format(Sys.time(),"%Y-%m-%d-%H")
    path <- here("CSVs/", sep="")
    filename <- paste(path,filedate,"-Swipes.csv")

    # store a message in the default 'quote' variable
    quote               <- as.character(Encouragement.Messages$Upbeat.Affirmations.[sample(1:length(na.omit(Encouragement.Messages$Upbeat.Affirmations.)), 1, replace=FALSE)])

    # this code renders default output to the "quote" and "resultsTable" UI elements
    output$quote        <- renderText({ quote })
    output$resultsTable <- renderDataTable({appVals$keeperswipes})

    #Reactive container for each new quote and a DF tracking swipe directions
    appVals <- reactiveValues(
        quote            = quote,
        # swipes = data.frame(quote = character(), author = character(), swipe = character())
        swipes           = data.frame(quote = character(), swipe = character()),
        keeperswipes     = data.frame(quote = character(), swipe = character()),
        selected.DF      = Encouragement.Messages,
        selections.Names = setNames(colnames(Encouragement.Messages), colnames(Encouragement.Messages) %>% gsub("\\.", " ", .) %>% gsub(' $', '', .))
    )

    # Obserer to watch for card_swipes and write each to a new row in the appVals$swipes DB
    observeEvent( card_swipe(),{
        #Record our last swipe results.
        appVals$swipes <- rbind(
            data.frame(quote = appVals$quote,
                       # author = appVals$quote$author,
                       swipe = card_swipe()

            ),
            appVals$swipes
        )

        #uses appvals$keepers to only display the right swipe quotes in the UI table
        if(as.character(card_swipe()) == "right"){
            appVals$keeperswipes <- rbind(
                data.frame(quote = appVals$quote,
                           # author = appVals$quote$author,
                           swipe = card_swipe()
                ),
                appVals$keeperswipes
            )
        }

        #Prepare each swipe for writing to CSV (avoids dupes)
        appVals$csvLog <- rbind(
            data.frame(category = input$messageCategory.selector,
                       quote = appVals$quote,
                       # author = appVals$quote$author,
                       swipe = card_swipe(),
                       time = format(Sys.time(),"%Y-%m-%d %H:%M:%OS3")
            )
        )

        #send results to the output UI element resultsTable.
        # if(as.character(card_swipe()) == "right"){
        output$resultsTable <- renderTable({appVals$keeperswipes})
        # }

        #update the quote displayed in the quote UI element
        #second version dynamically selects message category based on drop down
        # appVals$quote <- Encouragement.Messages$Upbeat.Affirmations.[sample(1:length(na.omit(Encouragement.Messages$Upbeat.Affirmations.)), 1, replace=FALSE)]
        appVals$quote <- appVals$selected.DF[[input$messageCategory.selector]][sample(1:length(na.omit(appVals$selected.DF[[input$messageCategory.selector]])), 1, replace=FALSE)]

        #send update to the ui.
        output$quote <- renderText({ appVals$quote })

        #write rvs$movements to CSV on server
        write.table(appVals$csvLog, file=filename %>% gsub(" ", "", .), sep=",", dec=".", append=TRUE, col.names=FALSE)

    }) #close Card_Swipe event observer.

    #Updates message if new value selected from dropdown
    observeEvent(input$messageCategory.selector, {
        # appVals$quote <- Encouragement.Messages$Upbeat.Affirmations.[sample(1:length(na.omit(Encouragement.Messages$Upbeat.Affirmations.)), 1, replace=FALSE)]
        appVals$quote <- appVals$selected.DF[[input$messageCategory.selector]][sample(1:length(na.omit(appVals$selected.DF[[input$messageCategory.selector]])), 1, replace=FALSE)]

        #send update to the ui.
        output$quote <- renderText({ appVals$quote })
    })

}

shinyApp(ui, server)

[nstrayer]

Hi Jules,

I just got everything loaded and was able to recreate your issue. I'll work on it and get back to you when I figure out what's going wrong.

Thanks for the example!

Best, Nick