Проблемы с объектом в Shiny

Question

У меня проблема с попыткой создать приложение Shiny.С этой таблицей:

data <- data.frame(
  variable1 = c('S','S','S','N','N','N'),
  variable2 = c('S','S','N','N','N','N'),
  TYPE = c('REAL','ESTUDIO','REAL','ESTUDIO','REAL','ESTUDIO')
  )

Пользовательский интерфейс:

    ui <- fluidPage(
  selectInput(inputId = "variable", 
              label = "Variable:",
              choices = c("variable1","variable2"), 
              selected = "variable1"),

  selectInput(inputId = "medida", 
              label = "Medida:",
              choices = c("Mix","Freq"), 
              selected = "Mix"),

  plotOutput("plot"))

Сервер:

server <- function(input, output) {

  dateRangeInput<-reactive({
    dataset = data %>%
      group_by(variable1,TYPE) %>%
      summarise(Freq=n()) %>%
      inner_join(data %>%
                   group_by(TYPE) %>%
                   summarise(Freq_Tot=n())
                 ,
                 by="TYPE") %>%
      mutate(Mix=Freq/Freq_Tot)
    dataset
  })

  output$plot <-renderPlot({
    ggplot(data=dateRangeInput(), 
           aes_string(x=input$variable,
                      y=input$medida,
                      fill="TYPE")) +
      geom_bar(stat="identity",
               position="dodge")
  })

}

Работает нормально (я предполагаю, что это не лучший R-код историиЯ только учусь), и если я запустил окончательный код:

shinyApp (ui = ui, server = server)

Результаты:

Как вы можетевидите, я сделал простое приложение (я только начинаю), поэтому я хотел иметь график с переменной, которую я выбираю в пользовательском интерфейсе.Поэтому, когда я делаю эти изменения:

• В коде сервера, когда я определяю dateRangeInput, я использовал в группе переменную "variable1".

• Теперь вместо этого я поместил переменную input $.

  dateRangeInput<-reactive({
    dataset = data %>%
      group_by(input$variable,TYPE) %>%
      summarise(Freq=n()) %>%
      inner_join(data %>%
                   group_by(TYPE) %>%
                   summarise(Freq_Tot=n())
                 ,
                 by="TYPE") %>%
      mutate(Mix=Freq/Freq_Tot)
    dataset
  })
  

Это приводит к этой ошибке:

Я думаю, что код не понимаетвывод в виде переменной.Я пытался исправить это с помощью функции переключения, но это не сработало.

Answer 1

На мой взгляд, проблема заключается в первоначальном подсчете переменных.Это потому, что ваш код выше рассматривает только variable1, а не обе переменные. Это означает, что блестящее приложение выдаст ошибку при запросе переменной 2.

При создании блестящего приложения для не больших данных я обычно создаю скрипт, который выполняетнасколько я могу без реактивных элементов.В этом случае это даст мне следующее:

library(shiny)
library(tidyverse)

data <- tibble(
    variable1 = c('S','S','S','N','N','N'),
    variable2 = c('S','S','N','N','N','N'),
    TYPE = c('REAL','ESTUDIO','REAL','ESTUDIO','REAL','ESTUDIO')
)

data1 <- data %>% 
    transmute_all(as_factor)

data_tidy <- data1 %>% 
    gather(
        key = "Variable", 
        value = "value", 
        -TYPE
        )

..., которое генерирует:

# A tibble: 12 x 3
   TYPE    Variable  value
   <fct>   <chr>     <chr>
 1 REAL    variable1 S    
 2 ESTUDIO variable1 S    
 3 REAL    variable1 S    
 4 ESTUDIO variable1 N    
 5 REAL    variable1 N    
 6 ESTUDIO variable1 N    
 7 REAL    variable2 S    
 8 ESTUDIO variable2 S    
 9 REAL    variable2 N    
10 ESTUDIO variable2 N    
11 REAL    variable2 N    
12 ESTUDIO variable2 N  

Затем мы можем суммировать эти данные:

data_summary_Freq <- data_tidy %>% 
    count(TYPE, Variable, value, name = "Freq")

data_summary_Total <- data_summary_Freq %>% 
    group_by(Variable, TYPE) %>% 
    summarise(total = sum(Freq))

data_summary <- data_summary_Freq %>% 
    left_join(
        data_summary_Total, 
        by = c("Variable", "TYPE")
        ) %>% 
    mutate(Mix = Freq / total) %>% 
    gather("Output", "Number", -TYPE, -Variable, -value, -total)

... и это приводит к следующим результатам для data_summary:

# A tibble: 16 x 6
   TYPE    Variable  value total Output Number
   <fct>   <chr>     <chr> <int> <chr>   <dbl>
 1 REAL    variable1 N         3 Freq    1    
 2 REAL    variable1 S         3 Freq    2    
 3 REAL    variable2 N         3 Freq    2    
 4 REAL    variable2 S         3 Freq    1    
 5 ESTUDIO variable1 N         3 Freq    2    
 6 ESTUDIO variable1 S         3 Freq    1    
 7 ESTUDIO variable2 N         3 Freq    2    
 8 ESTUDIO variable2 S         3 Freq    1    
 9 REAL    variable1 N         3 Mix     0.333
10 REAL    variable1 S         3 Mix     0.667
11 REAL    variable2 N         3 Mix     0.667
12 REAL    variable2 S         3 Mix     0.333
13 ESTUDIO variable1 N         3 Mix     0.667
14 ESTUDIO variable1 S         3 Mix     0.333
15 ESTUDIO variable2 N         3 Mix     0.667
16 ESTUDIO variable2 S         3 Mix     0.333

Оставшаяся проблема заключается в построении блестящего кода вокруг этого фрейма данных.

В целом это означает:

library(shiny)
library(tidyverse)

data <- tibble(
    variable1 = c('S','S','S','N','N','N'),
    variable2 = c('S','S','N','N','N','N'),
    TYPE = c('REAL','ESTUDIO','REAL','ESTUDIO','REAL','ESTUDIO')
)

data1 <- data %>% 
    transmute_all(as_factor)

data_tidy <- data1 %>% 
    gather(
        key = "Variable", 
        value = "value", 
        -TYPE
        )

data_summary_Freq <- data_tidy %>% 
    count(TYPE, Variable, value, name = "Freq")

data_summary_Total <- data_summary_Freq %>% 
    group_by(Variable, TYPE) %>% 
    summarise(total = sum(Freq))

data_summary <- data_summary_Freq %>% 
    left_join(
        data_summary_Total, 
        by = c("Variable", "TYPE")
        ) %>% 
    mutate(Mix = Freq / total) %>% 
    gather("Output", "Number", -TYPE, -Variable, -value, -total)

ui <- fluidPage(
    selectInput(inputId = "variable", 
                label = "Variable:",
                choices = c("variable1","variable2"), 
                selected = "variable1"),

    selectInput(inputId = "medida", 
                label = "Medida:",
                choices = c("Mix","Freq"), 
                selected = "Mix"),

    plotOutput("plot")
    )

server <- function(input, output) {

    dateRangeInput <- reactive({
        data_summary %>% 
            filter(
                Variable == input$variable,
                Output == input$medida
                )
    })

    output$plot <-renderPlot({
        dateRangeInput() %>% 
            ggplot() +
            geom_bar(
                aes(
                    x = value,
                    y = Number, 
                    group = TYPE,
                    fill = TYPE
                    ),
                stat = "identity",
                position = "dodge"
                ) +
            labs(
                title = paste(input$medida, "information about", input$variable)
            )
        })

}

shinyApp (ui = ui, server = server)

... который генерирует это приложение , которое я загрузил в shinyapps.io .

Я надеюсь, что я понялВаша проблема правильно и что это помогает.

Всего наилучшего ...