Есть ли функция R в R Shiny, чтобы знать средства по категориям

Question

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

$ оператор недопустим для атомных векторов

Я вижу некоторую ошибку в коде

output$mean <- renderUI({tapply(Unit_Price, Material, mean)})

---

Unit_Price <- c(60, 49, 40, 61, 64, 60, 59, 54, 62, 69, 70, 42, 56,
                61, 61, 61, 58, 51, 48, 65, 49, 49, 41, 48, 52, 46,
                59, 46, 58, 43)

Material <- c("tas", "sa", "qld", "nsw", "nsw", "nt", "wa", "wa",
              "qld", "vic", "nsw", "vic", "qld", "qld", "sa", "tas",
              "sa", "nt", "wa", "vic", "qld", "nsw", "nsw", "wa",
              "sa", "act", "nsw", "vic", "vic", "act")

library(shiny)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(selectInput("x","Value of x",choices = c("ComA","ComB")),
                 checkboxInput("mean","Mean Prices are"),
                 uiOutput("mean")),
    mainPanel(h6("Here it is"),
              tableOutput("message")
    )
  )
)

server <- function(input, output, session) {
  output$message <- renderTable(
    {
      if(input$x == "ComA")
      {
        data.frame(Unit_Price,Material)
      } else 
      {
        if(input$x == "ComB")
        {
          data.frame(Material=c("A","B"),Unit_Price=c(7,8))
        }
      }
    }
  )
  output$mean <- renderUI({tapply(Unit_Price, Material, mean)})
}

shinyApp(ui, server)

Answer 1

Если вы обменяете renderUI на renderTable, по крайней мере, вы больше не получаете сообщение об ошибке.

То есть серверная часть:

  output$mean <- renderTable(rownames = TRUE, {
    a <- tapply(Unit_Price, Material, mean)
    data.frame(a)
  }) 

Часть пользовательского интерфейса также должна быть соответствующим образом адаптирована. Так что uiOutput становится tableOutput.

Но мне все еще не очень ясно, чего вы на самом деле пытаетесь достичь. Должны ли данные Unit_Price и Material быть интерактивными, чтобы можно было рассчитать средние значения выбранного в настоящий момент элемента data.frame? Если это так, то имеет смысл создать этот data.frame в reactive, к которому вы сможете получить доступ во всех других серверных функциях.

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

Вот пример использования реактива для данных.

РЕДАКТИРОВАТЬ: Так как таблица средств должна появляться только при нажатии флажка, я включил небольшой req(input$mean) в output$mean, который ждет, пока флажок не будет нажат и возвращает ИСТИНА, в противном случае код не будет работать, и таблица не будет отображаться.

library(shiny)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(selectInput("x","Value of x",choices = c("ComA","ComB")),
                 checkboxInput("mean","Mean Prices are"),
                 tableOutput("mean")),
    mainPanel(h6("Here it is"),
              tableOutput("message")
    )
  )
)

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

  data <- reactive({
    if (input$x == "ComA") {
      data.frame(Unit_Price, Material)
    } else if (input$x == "ComB") {
      data.frame(Material=c("A","B"), Unit_Price=c(7,8))
    }
  })

  output$message <- renderTable({
    data()
  })

  output$mean <- renderTable(rownames = TRUE, {
    req(input$mean)
    df <- data()
    tapply(df$Unit_Price, df$Material, mean)
  })
}

shinyApp(ui, server)