RinteRface / argonDash

argon dashboard template
https://rinterface.github.io/argonDash/
138 stars 37 forks source link

Update ArgonTabItems in my Shiny app #36

Closed awkena closed 1 year ago

awkena commented 1 year ago

I tried to use this JS to update argonTabItems in my Shiny app, but it does not work. Basically, I am trying to use an action button on one tab to navigate to the next tab on my sidebar upon clicking the action button. Upon clicking the action button, a blank tab is opened instead. Can you help me to fix this issue? Here is a summary of my code:

library(shiny) library(argonR) library(argonDash) library(shinyjs) library(shinyWidgets)

Defines site header

argonHeader <- argonDashHeader( gradient = TRUE, color = "primary", separator = FALSE, separator_color = "secondary",

argonH1("Prototype - EasyPlotLabelR", display = 3, class = "text-center") )

Defines site sidebar

argonSidebar <- argonDashSidebar( id = "my_sidebar", vertical = TRUE, skin = "light", background = "white", size = "md", side = "left",

argonSidebarHeader(title = "Main Menu"), argonSidebarMenu(

argonSidebarItem(
  tabName = "welcome",
  icon = argonIcon(name = "cloud-upload-96", color = "info"),
  "Welcome"
),

argonSidebarItem(
  tabName = "data_import",
  icon = argonIcon(name = "cloud-upload-96", color = "info"),
  "Import fieldbook"
),

argonSidebarItem(
  tabName = "label_info",
  icon = argonIcon(name = "tag", color = "green"),
  "Label information"
),

),

argonSidebarDivider() )

Defines site footer

argonFooter <- argonDashFooter( copyrights = "Copyright © 2023 Alex Kena | Ebenezer Ogoe | Clara Burgos | Geoff Morris", src = NULL, argonFooterMenu( argonFooterItem("Follow Alex Kena on GitHub", src = "https://github.com/awkena"), argonFooterItem("View Ebenezer Ogoe's profile", src = NULL) ) )

Welcome page

pg_welcome <- argonTabItem( tabName = "welcome",

First row of logos

Some intro text that may need to be summarized into two paragraphs or less

argonH1("Welcome!", display = 4), p("Welcome to EasyPlotLabelR, a no-frills R Shiny app for designing experimental or trial plot labels affixed with QR codes for digital data collection. This open-source software simplifies the complicated process of plot label design. It generates plot labels that are compatible with the widely used digital data collection mobile app, Fieldbook.", style = "text-align: justify; margin-top: 10px;"),

p("The software requires users to upload a field book (csv file format) that contains LOCATION, PLOT, REP, ROW, RANGE/COLUMN, iBLOCK (if present), ENTRY/TREATMENT information. The column names of the imported field book do not necessarily have to match what is listed above, and do not have to be in any particular order.", style = "text-align: justify; margin-top: 10px;"),

p("Our app uses an informative unique ID to generate QR codes with different error correction levels. Users can upload a field book that already contains an informative unique ID for each plot or opt for the app to create informative unique plot IDs. It creates an informative unique plot ID by concatenating LOCATION, YEAR, PLOT, ROW and RANGE/COLUMN IDs into a string separated by an underscore. Eg. AKRON_2023_101_1_2", style = "text-align: justify; margin-top: 10px;"),

p("Users can choose from a list of preset common label templates as shown in the sample labels below. Alternatively, users can design any custom rectangular label given the page and label setting parameters.", style = "text-align: justify; margin-top: 10px;"),

p(" The app outputs a downloadable PDF file based on user-defined page and label setting parameters for printing. It also allows users to download an updated field book if the informative unique IDs for generating QR codes were created in the app.", style = "text-align: justify; margin-top: 10px;"),

)

Fieldbook import tab setup

pg_data_import <- argonTabItem( tabName = "data_import", argonCard( width = 12, title = "Upload your data", src = NULL, hover_lift = FALSE, shadow = TRUE, shadow_size = NULL, hover_shadow = FALSE, border_level = 0, icon = argonIcon("atom"), status = "primary", background_color = NULL, gradient = FALSE, floating = FALSE,

# Custom CSS to style the file upload widget. The specific classes and IDs were
# identified with Mozilla Firefox's Inspect element
tags$style(HTML('#datUploader_progress {height: 15px !important;}
                .input-group .form-control:not(:first-child) {
                padding-left: 10px; border-left: 0;}
                ')),

fileInput(inputId = "datUploader", "Upload a Fieldbook file in CSV format:",
          accept = ".csv", width = '50%', placeholder = "  No file selected"),

shinyjs::disabled(prettySwitch(inputId = "from_fieldhub", inline = TRUE,
                               label = tags$strong("Generated with FieldHub"),
                               value = FALSE, status = "primary", fill = TRUE)),

shinyjs::disabled(prettySwitch(inputId = "from_BMS", inline = TRUE,
                               label = tags$strong("Generated with BMS"),
                               value = FALSE, status = "primary", fill = TRUE)),

shinyjs::disabled(prettySwitch(inputId = "preview_dat", inline = TRUE,
                               label = tags$strong("Preview uploaded Fieldbook"), 
                               value = FALSE, status = "primary", fill = TRUE)),

br(),

fluidRow(
  column(width = 4,
         actionButton(inputId = "submit_dat", "Submit Fieldbook")),

  column(width = 4, offset = 3,
         actionButton(inputId = "npg1", "Next >>"))
)

)

)

Label information tab setup

warn <- "Submit a Fieldbook first"

pg_label_info <- argonTabItem( tabName = "label_info",

Mimics a classic ArgonUI card

argonCard(

Card configuration

width = 12,
title = "Page parameters",
src = NULL,
hover_lift = FALSE,
shadow = TRUE,
shadow_size = NULL,
hover_shadow = FALSE,
border_level = 0,
icon = argonIcon("atom"),
status = "primary",
background_color = NULL,
gradient = FALSE,
floating = FALSE,

# Page items
fluidRow(

  column(width = 2,
         prettyCheckbox(inputId = "IBlock", label = "Incomplete blocks", 
                        value = FALSE, inline = TRUE,
                        status = "primary", shape = "curve", outline = TRUE)),

  column(width = 3, offset = 1,
         shinyjs::disabled(sliderInput(inputId = "ec_level", label = "QR code error level",
                                       min = 0, max = 3, step = 1, value = 3))),

  column(width = 3, offset = 1,

         shinyjs::disabled(actionButton(inputId = "gen_qrcode", label = ("Generate QR codes "),
                                        icon = NULL, width = NULL, span(id="Animate", class="")))),

),

br(),

fluidRow(

  column(width = 4,
         prettyCheckbox(inputId = "get_unique_id", inline = TRUE,
                        label = "Generate unique IDs for QR codes",
                        value = TRUE, status = "primary", shape = "curve", outline = TRUE)),

fluidRow(
  column(width = 6,
         textInput(inputId = "rname", label = "Input your name",
                   value = "", placeholder = 'Initial(s) + Last name'),
  ),

  column(width = 6,

         textInput(inputId = "yr", label = "Input year of experiment",
                   value = ""))),

fluidRow(
  column(width = 6,
         selectInput(inputId = "rep_id", "Select ID for REP", choices = warn),
         selectInput(inputId = "row_id", "Select ID for ROW", choices = warn),
         selectInput(inputId = "loc_id", "Select ID for LOCATION", choices = warn),
         selectInput(inputId = "IBlock_id", "Select ID for IBlock", choices = warn)
  ),

  column(width = 6,
         selectInput("plot_id", "Select ID for PLOT", choices = warn),
         selectInput("col_id", "Select ID for COLUMN", choices = warn),
         selectInput("entry_id", "Select ID for TREATMENT/ENTRY", choices = warn),
         selectInput("unique_id", "Select ID for UNIQUE IDs", choices = warn)
  )
),

fluidRow(
  column(width = 4,
         actionButton(inputId = "npg2", "Next >>")),
)

) )

)

Piece everything together in UI

ui <- argonDashPage(

title = "EasyPlotLabelR", author = "Alexander Wireko Kena, Ebenezer Ogoe", description = "A Shiny app to generate digital plot labels freely and easily", sidebar = argonSidebar, navbar = NULL, header = argonHeader, body = argonDashBody(

# recover the R export in JS in the message arg. Message is an object.
# If on the R side message was a list, you can access its children by
# message.children.
shiny::tags$head(
  shiny::tags$script(
    'Shiny.addCustomMessageHandler("update-tabs", function(message) {
            var currentTab = parseInt(message);
            console.log(message); // we check if the message is displayed

            // hide and inactivate all not selected tabs
            $(".active.show").removeClass("active show");
            $(".tab-pane.active.show").removeClass("active show");

            // add active class to the current selected tab and show its content
            $("#tab-Tab" + currentTab).addClass("active show");
            $("#shiny-tab-Tab" + currentTab).addClass("active show");
           });
          '
  )
),

tags$head(
  tags$style(
    HTML(".shiny-notification {
          height: 100px;
          width: 300px;
          position:fixed;
          top: calc(25% - 30px);;
          left: calc(80% - 200px);;
        }
       "
    )
  )
),

useShinyjs(),
argonTabItems(
  pg_welcome,
  pg_data_import,
  pg_label_info

)

),

footer = argonFooter

)

Server component of app

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

stop app when app is closed

session$onSessionEnded(function() { stopApp() })

send data from R to Javascript

observeEvent(input$npg1, { session$sendCustomMessage( type = "update-tabs", message = input$npg2 ) })

}

enableBookmarking(store = "server") shinyApp(ui, server)