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

Question

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

Предупреждение. Ошибка в операторе $: $ недопустима для атомарных векторов [трассировка стека недоступна]

Предупреждение. Ошибка в renderUI: data 'data_available'не может быть найдено [Нет трассировки стека]

Я понятия не имею, где что-то пошло не так.Ниже приведен код моего блестящего приложения:

library(shiny)
library(ggplot2)
library(dplyr)

data_events <- read.csv("Desktop/athlete_events.csv")
df.physical <-data_events %>% select(Height,Weight,Sex,Year,Sport) %>% 
filter(!is.na(Height),!is.na(Weight))
df.physical <-as.data.frame(df.physical)

ui<- fluidPage(
  titlePanel("Distribution of Height/Weight for Each Sport"),
  sidebarLayout(
    sidebarPanel(
      helpText("Create a scatter plot of height/weight for every sport in the 
Olympics."),

  htmlOutput("sport_selector"),
  htmlOutput("year_selector"),
  htmlOutput("sex_selector")

)
,
mainPanel(
  plotOutput("olmypicphysical"))
  )
)
server=shinyServer(function(input,output){
  output$sport_selector = renderUI({
    selectInput(inputId="sport", label= "Sport:", 
choices=as.character(unique(df.physical$Sport))
    )})
  output$year_selector = renderUI({
    data_available=df.physical[df.physical$Sport == input$sport, "Year"]
    selectInput(inputId = "year", label="Year:", 
choices=unique(data_available$Year))
  })
  output$sex_selector = renderUI({
    data_available1=data_available[data_available$Year == input$year, "Sex"]
    selectInput(inputId = "Sex",label="Sex:", 
choices=unique(data_available1$Sex))
    data_available2=data_available1[data_available1$Sex ==input$sex, 
"Physical"]
    output$olympicphysical = renderPlot({ 
ggplot(data_available2,aes(x=data_available2$Height,y=data_available2$Weight)
)+ geom_point()+theme_classic()+labs(x="Height",y="Weight")
    })
  })
})
shinyApp(ui = ui, server = server)

Созданный мною набор данных df.physical (тип is list) выглядит следующим образом:

df.physical

Пожалуйста, кто-нибудь может мне помочь?

Answer 1

С вашим кодом довольно много проблем.Ваш вопрос о $ operator is invalid for atomic vectors.Действительно, это вызвано вашим методом выбора.Сначала вы выбираете вектор из вашего data.frame, а затем снова пытаетесь заменить этот вектор на имя, которое он имел в data.frame.

Обычно вы пытаетесь применить один и тот же выбор дважды.Легко исправить, пропустив имя столбца при первом выборе:

data_available=df.physical[df.physical$Sport == input$sport, ]

Кроме того, я не уверен, почему вы используете htmlOutput в сочетании с renderUI.Если вы хотите обновить / ограничить ваш выбор в selectInput, вы можете просто использовать функцию updateSelectInput в сочетании с ObserveEvent.Это делает ваше приложение более читабельным и менее подверженным ошибкам.

Рабочий пример:

library(shiny)
library(ggplot2)

ui<- fluidPage(
  titlePanel("Distribution of Height/Weight for Each Sport"),
  sidebarLayout(
    sidebarPanel(
      helpText("Create a scatter plot of height/weight for every sport in the 
               Olympics."),
      selectInput("sport_selector", choices=c(''), label='Sport:'),
      selectInput("year_selector", choices=c(''), label='Year:'),
      selectInput("sex_selector", choices=c(''), label='Sex:')
      )
    ,
    mainPanel(
      plotOutput("olympicphysical"))
  )
)

server<-shinyServer(function(input,output, session){
  df.physical = data.frame(Height=c(170,180),Weight=c(80,80),Sex=c('M','F'), Year=c(1992,2012), Sport=c('Basketball', 'Judo'))

  updateSelectInput(session, 'sport_selector', choices = unique(df.physical$Sport))

  observeEvent(input$sport_selector, {
    df.physical_subset = subset(df.physical, Sport == input$sport_selector)
    updateSelectInput(session, 'year_selector', choices = unique(df.physical_subset$Year))
  })

  observeEvent({input$year_selector}, {
    df.physical_subset = subset(df.physical, Sport == input$sport_selector & Year == input$year_selector)
    updateSelectInput(session, 'sex_selector', choices = unique(df.physical_subset$Sex))
  })

  observeEvent({input$sex_selector},{
    df.physical_subset <- subset(df.physical, Sport == input$sport_selector & Year == input$year_selector & Sex==input$sex_selector)
    print(df.physical_subset)
    output$olympicphysical = renderPlot({
      ggplot(df.physical_subset,aes(x=df.physical_subset$Height,y=df.physical_subset$Weight)
      )+ geom_point()+theme_classic()+labs(x="Height",y="Weight")})
  })
})

shinyApp(ui = ui, server = server)