wip on ui

data-raw/app/app.R

@@ -0,0 +1,82 @@
+library(shiny)
+library(ready4)
+source("functions.R")
+
+mpgData <- mtcars
+mpgData$am <- factor(mpgData$am, labels = c("Automatic", "Manual"))
+classes_lup <-  make_classes_lup(exclude_1L_chr = "S3",
+                                 libraries_chr = "ready4show")
+# abbreviations_lup <- ready4fun::get_rds_from_pkg_dmt(fl_nm_1L_chr = "abbreviations_lup",
+#                                             piggyback_to_1L_chr = "ready4-dev/ready4")
+# object_type_lup <- ready4fun::get_rds_from_pkg_dmt(fl_nm_1L_chr = "object_type_lup",
+#                                           piggyback_to_1L_chr = "ready4-dev/ready4")
+ui <- fluidPage(
+  headerPanel("ready4 User Interface"),
+  sidebarLayout(
+    sidebarPanel(
+      import_modules_UI("modelmods",
+                        #modules_chr = "Ready4showSynopsis",
+                        classes_lup = classes_lup),
+      #h3(textOutput("modulename")),
+      textOutput("testX"),
+      # p("The checkbox group controls the select input"),
+      # checkboxGroupInput("inCheckboxGroup", "Input checkbox",
+      #                    c("Item A", "Item B", "Item C")),
+      # selectInput("inSelect", "Select input",
+      #             c("Item A", "Item B", "Item C")),
+      plot_cars_UI("mpgplot"),
+      import_csv_UI("datafile", "User data (.csv format)")
+    ),
+    mainPanel(
+      h3(textOutput("caption")),
+      plotOutput("mpgPlot"),
+      dataTableOutput("table")
+    )
+  )
+)
+server <- function(input, output, session) {
+  modules_ls <- reactiveValues(X=NULL,
+                               contents_ls = NULL,
+                               names_ls = NULL,
+                               tree_names_ls = NULL
+                               )
+  module_meta_ls <- import_modules_Server("modelmods",
+                                          classes_lup = classes_lup)
+   # output$modulename <- renderText({
+  #   module_meta_ls$module_nm_fn()
+  # })
+  observeEvent(input$modelmods, {
+  modules_ls$X = module_meta_ls$X_fn()
+  # modules_ls$contents_ls = make_module_contents_ls(x, classes_lup = classes_lup, what_1L_chr = "contents")
+  # modules_ls$names_ls = make_module_contents_ls(modules_ls$X, classes_lup = classes_lup)
+  # modules_ls$tree_names_ls = make_list_tree_nms(modules_ls$names_ls)
+  })
+  # observe({
+  #   updateSelectInput(session, "inSelect",
+  #                     label = paste("Select input label", length(x)),
+  #                     choices = unlist(modules_ls$tree_names_ls)
+  #                     # ,
+  #                     # selected = tail(x, 1)
+  #   )
+  # })
+  output$testX <- renderText({
+    #module_meta_ls$X_fn()@outp_formats_chr
+    module_meta_ls$X_ls_fn()$tree_names_ls %>% length() %>% as.character() #unlist() %>% unname() %>% tail(1)
+    #slotNames(module_meta_ls$X_fn())[1]
+
+    #"PDF"
+    # modules_ls$X@outp_formats_chr
+  })
+  caption_fn <- plot_cars_Server("mpgplot", mpgData)
+  output$caption <- renderText({
+    caption_fn()
+  })
+  output$mpgPlot <- renderPlot({
+    plot_cars_Server("mpgplot", mpgData, fml_1L_chr = caption_fn())
+  })
+  datafile <- import_csv_Server("datafile", as_fctrs_1L_lgl = FALSE)
+  output$table <- renderDataTable({
+    datafile()
+  })
+}
+shinyApp(ui, server)

data-raw/app/app1.R

@@ -0,0 +1,69 @@
+csvFileUI <- function(id, label = "CSV file") {
+  # `NS(id)` returns a namespace function, which was save as `ns` and will
+  # invoke later.
+  ns <- NS(id)
+
+  tagList(
+    fileInput(ns("file"), label),
+    checkboxInput(ns("heading"), "Has heading"),
+    selectInput(ns("quote"), "Quote", c(
+      "None" = "",
+      "Double quote" = "\"",
+      "Single quote" = "'"
+    ))
+  )
+}
+# Module server function
+csvFileServer <- function(id, stringsAsFactors) {
+  moduleServer(
+    id,
+    ## Below is the module function
+    function(input, output, session) {
+      # The selected file, if any
+      userFile <- reactive({
+        # If no file is selected, don't do anything
+        validate(need(input$file, message = FALSE))
+        input$file
+      })
+
+      # The user's data, parsed into a data frame
+      dataframe <- reactive({
+        read.csv(userFile()$datapath,
+                 header = input$heading,
+                 quote = input$quote,
+                 stringsAsFactors = stringsAsFactors)
+      })
+
+      # We can run observers in here if we want to
+      observe({
+        msg <- sprintf("File %s was uploaded", userFile()$name)
+        cat(msg, "\n")
+      })
+
+      # Return the reactive that yields the data frame
+      return(dataframe)
+    }
+  )
+}
+library(shiny)
+
+ui <- fluidPage(
+  sidebarLayout(
+    sidebarPanel(
+      csvFileUI("datafile", "User data (.csv format)")
+    ),
+    mainPanel(
+      dataTableOutput("table")
+    )
+  )
+)
+
+server <- function(input, output, session) {
+  datafile <- csvFileServer("datafile", stringsAsFactors = FALSE)
+
+  output$table <- renderDataTable({
+    datafile()
+  })
+}
+
+shinyApp(ui, server)

data-raw/app/app3.R

@@ -0,0 +1,43 @@
+library(shiny)
+library(stringi)
+stack.shiny <- function(){
+  dat_set <- mtcars
+
+  all_cars <- row.names(dat_set)
+
+  car_brands <- unique(stri_extract_first_words(all_cars))
+
+
+
+  server <- function(input, output, session) {
+
+    output$car_brands <- renderUI({
+      selectInput(inputId = 'select1', label = 'choose brand',
+                  choices = car_brands)
+    })
+
+    output$cars <- renderUI({
+      selectInput(inputId = 'select2', label = 'choose car',
+                  choices = all_cars)
+    })
+
+    observeEvent(input$select1, {
+      x <- input$select1
+      find_pat <- sprintf('^%s', x)
+      these_cars <- all_cars[grepl(find_pat, all_cars, perl = TRUE)]
+      # Can also set the label and select items
+      updateSelectInput(session, "select2",
+                        choices = these_cars,
+                        selected = NULL)
+    })
+  }
+
+  ui <- fluidPage(
+    uiOutput('car_brands'),
+    uiOutput('cars')
+  )
+
+  shinyApp(ui, server)
+
+}
+stack.shiny()