exemplos de reatividade e validacao

curso_gravado/scripts/18-exemplo-partidas.R

@@ -38,7 +38,6 @@ server <- function(input, output, session) {
   })
 
   output$select_time <- renderUI({
-    browser()
     if (!is.null(input$temporada)) {
       times <- dados |> 
         dplyr::filter(season == input$temporada) |> 

curso_gravado/scripts/25-observe-update.R

@@ -0,0 +1,39 @@
+library(shiny)
+
+ui <- fluidPage(
+  titlePanel("Validação"),
+  sidebarLayout(
+    sidebarPanel(
+      selectInput(
+        inputId = "cyl",
+        label = "Número de cilindros",
+        choices = sort(unique(mtcars$cyl))
+      ),
+      selectInput(
+        inputId = "carro",
+        label = "Carro",
+        choices = c("Carregando..." = "")
+      ),
+    ),
+    mainPanel(
+    )
+  )
+)
+
+server <- function(input, output, session) {
+
+  observe({
+    carros <- mtcars |> 
+      dplyr::filter(cyl == input$cyl) |>
+      rownames() |> 
+      sort()
+    updateSelectInput(
+      session,
+      "carro",
+      choices = carros
+    )
+  })
+
+}
+
+shinyApp(ui, server)

curso_gravado/scripts/26-modais.R

@@ -0,0 +1,50 @@
+library(shiny)
+
+ui <- fluidPage(
+  titlePanel("Preencha o formulário"),
+  hr(),
+  textInput(
+    inputId = "nome",
+    label = "Nome",
+    value = "",
+    placeholder = "João da Silva"
+  ),
+  dateInput(
+    inputId = "data_nascimento",
+    label = "Data de nascimento",
+    max = Sys.Date(),
+    value = Sys.Date(),
+    language = "pt-BR",
+    format = "dd-mm-yyyy"
+  ),
+  selectInput(
+    inputId = "estado",
+    label = "UF",
+    choices = c("Pará", "Rio de Janeiro", "Matro Grosso", "Ceará")
+  ),
+  actionButton(
+    inputId = "salvar",
+    label = "Salvar"
+  )
+)
+
+server <- function(input, output, session) {
+
+  observeEvent(input$salvar, {
+    tibble::tibble(
+      nome = input$nome,
+      data_nascimento = input$data_nascimento,
+      estado = input$estado
+    ) |> 
+      write.table(
+        "dados.txt",
+        append = TRUE,
+        sep = ",",
+        row.names = FALSE,
+        col.names = FALSE
+      )
+  })
+
+}
+
+shinyApp(ui, server)

curso_gravado/scripts/27-observeEvent.R

@@ -43,6 +43,13 @@ server <- function(input, output, session) {
         row.names = FALSE,
         col.names = FALSE
       )
+
+    showModal(modalDialog(
+      title = "Dados salvos",
+      "Seus dados foram salvos com sucesso!",
+      easyClose = TRUE,
+      footer = NULL
+    ))
   })
 
 }

curso_gravado/scripts/28-reactiveVal.R

@@ -0,0 +1,82 @@
+library(shiny)
+library(dplyr)
+
+ui <- fluidPage(
+  titlePanel("Cadastro de clientes"),
+  sidebarLayout(
+    sidebarPanel(
+      h3("Adicionar cliente"),
+      textInput(
+        "nome",
+        label = "Nome",
+        value = ""
+      ),
+      textInput(
+        "email",
+        label = "E-mail",
+        value = ""
+      ),
+      actionButton("adicionar", label = "Adicionar cliente"),
+      hr(),
+      h3("Remover cliente"),
+      selectInput(
+        "id",
+        label = "ID do cliente",
+        choices = c("Carregando..." = "")
+      ),
+      actionButton("remover", label = "Remover cliente")
+    ),
+    mainPanel(
+      tableOutput("tabela")
+    )
+  )
+)
+
+server <- function(input, output, session) {
+
+  tab_clientes <- reactiveVal(tibble::tibble(
+    id = 0L,
+    nome = "Fulano",
+    email = "[email protected]"
+  ))
+
+  observe({
+    clientes <- tab_clientes() |> 
+      dplyr::pull(id)
+
+    updateSelectInput(
+      session,
+      "id",
+      choices = clientes
+    )
+  })
+
+  observeEvent(input$remover, {
+    if (!input$id %in% tab_clientes()$id) {
+      showModal(modalDialog(
+        title = "Erro",
+        "ID não encontrado",
+        footer = modalButton("Fechar"),
+        easyClose = TRUE
+      ))
+    } else {
+      nova_tab <- tab_clientes() |> 
+        dplyr::filter(id != input$id)
+      tab_clientes(nova_tab)
+    }
+  })
+
+  observeEvent(input$adicionar, {
+    novo_id <- max(tab_clientes()$id) + 1L
+    nova_tab <- tab_clientes() |> 
+      tibble::add_row(id = novo_id, nome = input$nome, email = input$email, .before = 1)
+    tab_clientes(nova_tab)
+  })
+
+  output$tabela <- renderTable({
+    tab_clientes()
+  })
+
+}
+
+shinyApp(ui, server)

curso_gravado/scripts/29-validacao.R

@@ -0,0 +1,66 @@
+library(shiny)
+
+ui <- fluidPage(
+  titlePanel("Validação"),
+  sidebarLayout(
+    sidebarPanel(
+      width = 3,
+      selectInput(
+        inputId = "filme",
+        label = "Escolha um filme",
+        choices = c("Carregando..." = "")
+      ),
+      selectInput(
+        inputId = "personagem",
+        label = "Escolha um personagem",
+        choices = c("Carregando..." = ""),
+        multiple = TRUE
+      )
+    ),
+    mainPanel(
+      width = 9,
+      tableOutput("tabela")
+    )
+  )
+)
+
+server <- function(input, output, session) {
+
+
+  filmes <- dplyr::starwars |> 
+    tidyr::unnest(films) |> 
+    pull(films) |>
+    unique() |> 
+    sort()
+
+  updateSelectInput(
+    session, 
+    "filme",
+    choices = filmes
+  )
+
+  observe({
+    req(input$filme)
+    personagens <- dplyr::starwars |> 
+      tidyr::unnest(films) |> 
+      filter(films == input$filme) |> 
+      pull(name) |> 
+      sort()
+    updateSelectInput(session, "personagem", choices = personagens)
+  })
+
+  output$tabela <- renderTable({
+    validate(need(
+      isTruthy(input$personagem),
+      "Escolha ao menos um personagem."
+    ))
+    dplyr::starwars |> 
+      dplyr::filter(name %in% input$personagem) |>
+      dplyr::select(
+        name:species
+      )
+  })
+
+}
+
+shinyApp(ui, server)

curso_gravado/scripts/30-barra-de-progresso.R

@@ -0,0 +1,37 @@
+library(shiny)
+
+ui <- fluidPage(
+  titlePanel("Barra de progresso"),
+  sidebarLayout(
+    sidebarPanel(
+      varSelectInput(
+        inputId = "variavel",
+        label = "Eixo x",
+        data = mtcars
+      )
+    ),
+    mainPanel(
+      plotOutput("grafico")
+    )
+  )
+)
+
+server <- function(input, output, session) {
+
+  output$grafico <- renderPlot({
+
+    withProgress(message = "Coletando os dados...", {
+      Sys.sleep(1)
+      incProgress(1/3, message = "Manipulando dados...")
+      Sys.sleep(1)
+      incProgress(1/3, message = "Gerando gráfico...")
+      Sys.sleep(1)
+      plot(x = mtcars[[input$variavel]], y = mtcars$mpg)
+      incProgress(1/3)
+    })
+
+  })
+
+}
+
+shinyApp(ui, server)