Ошибки классификации данных Rshiny и сводной статистики

#r #shiny #tree #classification #summary

#r #блестящий #дерево #классификация #Краткие сведения

Вопрос:

Я новичок в Rshiny. Мне было поручено следующее:

Напишите блестящее приложение, которое использует панель навигации с заголовками «Исследование данных» и «Инструменты классификации», чтобы на вкладке «Исследование данных» пользователь мог:

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

на вкладке Инструменты классификации пользователь может:

используйте ползунок для выбора из (0.4, 0.5, 0.6, 0.7, 0.8), доля данных, используемых для набора обучающих данных (здесь мы не будем использовать тестовые данные, поэтому вы должны использовать пропорцию дополнения для набора данных проверки).
просмотрите дерево классификации для обучающих данных и используйте переключатели для «просмотра обрезанного дерева» или «просмотра необрезанного дерева». Где для обрезанного дерева обрезка должна выполняться с использованием значения cp, соответствующего наименьшей ошибке xerror.
смотрите как коэффициенты правильной, так и ошибочной классификации (с использованием данных проверки) для обрезанного дерева классификации и одного из LDA или QDA, эти результаты должны быть представлены в таблице. Должен быть выделен «Лучший» метод классификации, т. Е. Метод с наименьшей частотой ошибок классификации, и должно быть примечание, информирующее пользователя о том, что означает выделение.
сделайте прогноз состояния скорости (т. Е. Выше или ниже среднего значения по США) среднего невидимого состояния, используя «наилучший» метод классификации, с заданным пользователем набором наблюдаемых значений переменных (т. Е. Потребуются параметры ввода, позволяющие пользователю вводить желаемые наблюдаемые значения).). Определяемые пользователем значения по умолчанию, которые появляются при открытии приложения, должны быть средним значением непрерывных переменных и режимом категориальных переменных. Также должно быть предупреждение, которое предупреждает пользователя, когда они экстраполируют.

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

Когда я запускаю приложение после открытия Rstudio, моя первая вкладка «Исследование данных» работает нормально. Однако всякий раз, когда я перезагружаю приложение, сводная таблица завершается сбоем, и я получаю сообщение об ошибке «неиспользуемый аргумент (входная переменная $)«. Я не уверен, почему это происходит.
Когда я запускаю приложение, на второй вкладке «Инструменты классификации» появляется ошибка, которая гласит: «нечисловой аргумент для двоичного оператора«. Я исследовал, что это значит, и я думаю, что понимаю это, но я просто не уверен, как эта ошибка применима к моему коду. Вместо этой ошибки моя цель — создать таблицу, которая включает в себя скорость классификации и скорость неправильной классификации модели CART и, в конечном итоге, модели LDA (в зависимости от ввода доли обучающих данных).).
Следуя из выпуска 2, я исследовал свой код и понял, что, по-моему, предыдущая ошибка возникает из-за строки lda.pred <- predict(lda.model, newdata = valid.data[,-6]), и поэтому я удалил код, чтобы посмотреть, что произойдет, а затем я получаюновая ошибка ‘неиспользуемый аргумент (pred == допустимый.метка)‘. Опять же, я не понимаю, почему это происходит.

Вот мой код:

 data <- read.csv("Fatality-task2.csv")

data$Rate <- as.factor(data$Rate)

library(shiny)
library(dplyr)
library(ggplot2)
library(markdown)
library(gtsummary)
library(ggdendro)
library(factoextra)
library(mclust)
library(cluster)
library(rpart)
library(rpart.plot)
#library(MASS)

#################################################################


ui <- fluidPage(
  navbarPage("",
             tabPanel("Data Exploration",
                      sidebarLayout(
                        sidebarPanel(
                          selectInput("variable",
                                      "Variable",
                                      colnames(data)),
                          selectInput("rate",
                                      "Rate",
                                      levels(data$Rate))
                        ),
                        mainPanel(
                          tableOutput("table"),
                          plotOutput("plot")
                        )
                      )    
             ),
             tabPanel("Classification tools",
                      sidebarLayout( 
                        sidebarPanel(
                          sliderInput("train.prop",
                                      "Training data proportion",
                                      min = 0.4,
                                      max = 0.8,
                                      step = 0.1,
                                      value = 0.6),
                          radioButtons("prune",
                                       "Pruning option",
                                       choices = c("view pruned tree",
                                                   "view unpruned tree"))
                        ),
                        mainPanel(
                          tableOutput("table2"),
                          plotOutput("plot2")
                          
                        )
                      )
             )
  )
)




#################################################################

server <- function(input, output) {
  sum <- reactive({
    data <- data %>%
      filter(Rate == input$rate) %>%
      select(input$variable) %>%
      summary() %>%
      as.data.frame() %>%
      tidyr::separate(Freq, c("Stat", "Value"), sep=":") %>%
      tidyr::pivot_wider(names_from =Stat, values_from = Value)
    data <- data[, -c(1,2)]
    
  })
  
  output$table <- renderTable({
    sum()
  })
  
  output$plot <- renderPlot({
    if (input$variable == "jaild" | input$variable == "Rate"){
      ggplot(data, aes(x = Rate, fill = data[[input$variable]]))  
        geom_bar(position = "dodge", width = 0.7)  
        if (input$variable == "Rate"){
          theme(legend.position = "none")
        }
    } else {
      ggplot(data, aes(x = Rate, y = data[[input$variable]], fill = Rate))  
        geom_boxplot()  
        theme(legend.position = "none")
    }
    
    
  })
  
  output$plot2 <- renderPlot({
    
    set.seed(1234)
    n <- nrow(data)
    ind1 <- sample(c(1:n), round(n*input$train.prop))
    ind2 <- sample(c(1:n)[-ind1], length(c(1:n)[-ind1]))
    
    
    train.data <- data[ind1,]
    valid.data <- data[ind2,]
    
    
    fit.tree <- rpart(Rate~., data = train.data, method = "class")
    
    ptree <- prune(fit.tree, cp = fit.tree$cptable[which.min(fit.tree$cptable[,"xerror"]),"CP"])
    
    if (input$prune == "view pruned tree"){
      rpart.plot(ptree, uniform =TRUE)
    } else {
      rpart.plot(fit.tree)
    }
    
    
    
    
  })
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  #######################
  table <- reactive({
    #################################
    library(MASS)
    set.seed(1234)
    n <- nrow(data)
    ind1 <- sample(c(1:n), round(n*input$train.prop))
    #ind2 <- sample(c(1:n)[-ind1], length(c(1:n)[-ind1]))
    ind2 <- setdiff(c(1:n), ind1)
    
    
    train.data <- data[ind1,]
    valid.data <- data[ind2,]
    
    train.label <- data[ind1, 6]
    valid.label <- data[ind2, 6]
    
    #################################
    
    ### fit cart model
    fit.tree <- rpart(Rate~., data = train.data, method = "class")
    
    ### prune the tree
    ptree <- prune(fit.tree, cp = fit.tree$cptable[which.min(fit.tree$cptable[,"xerror"]),"CP"])
    
    ### predict using the validation data on the pruned tree
    pred <- predict(ptree, newdata = valid.data, type = "class")
    
    ### lda
    
    lda.model <- lda(train.data[,-6], train.label)
    
    #lda.pred <- predict(lda.model, newdata = valid.data[,-6])
    
    
    ### create a classification table
    
    
    
    CCR <- sum(pred == valid.label)/nrow(valid.data)
    MCR <- 1 - CCR
    
    CR <- c(CCR, MCR)
    
    CR <- as.data.frame(CR)
    colnames(CR) <- "CART"
    rownames(CR) <- c("CCR", "MCR")
    
  })
  
  
  
  
  
  
  
  
  
  
  
  
  
  #############################
  output$table2 <- renderTable({
    table()
    
  }) 
  
}




#################################################################
shinyApp(ui, server)

И мой вывод приложения выглядит так в приведенных выше 3 случаях (по порядку)

Я отчаянно нуждаюсь в помощи, поэтому любая помощь приветствуется. Если вам нужны какие-либо разъяснения по коду, дайте мне знать, пожалуйста.

~редактировать~

вот мой обновленный код после решения моих второй и третьей ошибок (я думаю?):

 data <- read.csv("Fatality-task2.csv")

data$Rate <- as.factor(data$Rate)

library(shiny)
library(dplyr)
library(ggplot2)
library(markdown)
library(gtsummary)
library(ggdendro)
library(factoextra)
library(mclust)
library(cluster)
library(rpart)
library(rpart.plot)
#library(MASS)

dput(head(data))

#################################################################


ui <- fluidPage(
  navbarPage("",
             tabPanel("Data Exploration",
                      sidebarLayout(
                        sidebarPanel(
                          selectInput("variable",
                                      "Variable",
                                      colnames(data)),
                          selectInput("rate",
                                      "Rate",
                                      levels(data$Rate))
                        ),
                        mainPanel(
                          tableOutput("table"),
                          plotOutput("plot")
                        )
                      )
             ),
             tabPanel("Classification tools",
                      sidebarLayout(
                        sidebarPanel(
                          sliderInput("train.prop",
                                      "Training data proportion",
                                      min = 0.4,
                                      max = 0.8,
                                      step = 0.1,
                                      value = 0.6),
                          radioButtons("prune",
                                       "Pruning option",
                                       choices = c("view pruned tree",
                                                   "view unpruned tree"))
                        ),
                        mainPanel(
                          tableOutput("table2"),
                          plotOutput("plot2")
                          
                        )
                      )
             )
  )
)




#################################################################

server <- function(input, output) {
  sum <- reactive({
    req(input$variable,input$rate)
    data <- data %>%
      filter(Rate == input$rate) %>%
      select(input$variable) %>%
      summary() %>%
      as.data.frame() %>%
      tidyr::separate(Freq, c("Stat", "Value"), sep=":") %>%
      tidyr::pivot_wider(names_from =Stat, values_from = Value)
    data <- data[, -c(1,2)]
    
  })
  
  output$table <- renderTable({
    sum()
  })
  
  output$plot <- renderPlot({
    req(input$variable)
    if (input$variable == "jaild" | input$variable == "Rate"){
      ggplot(data, aes(x = Rate, fill = .data[[as.name(input$variable)]]))  
        geom_bar(position = "dodge", width = 0.7)  
        if (input$variable == "Rate"){
          theme(legend.position = "none")
        }
    } else {
      ggplot(data, aes(x = Rate, y = .data[[as.name(input$variable)]], fill = Rate))  
        geom_boxplot()  
        theme(legend.position = "none")
    }
    
    
  })
  
  output$plot2 <- renderPlot({
    req(input$train.prop,input$prune)
    set.seed(1234)
    n <- nrow(data)
    ind1 <- sample(c(1:n), round(n*as.numeric(input$train.prop)))
    ind2 <- sample(c(1:n)[-ind1], length(c(1:n)[-ind1]))
    
    
    train.data <- data[ind1,]
    valid.data <- data[ind2,]
    
    
    fit.tree <- rpart(Rate~., data = train.data, method = "class")
    
    ptree <- prune(fit.tree, cp = fit.tree$cptable[which.min(fit.tree$cptable[,"xerror"]),"CP"])
    
    if (input$prune == "view pruned tree"){
      rpart.plot(ptree, uniform =TRUE)
    } else {
      rpart.plot(fit.tree)
    }
  })
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  #######################
  table <- reactive({
    #################################
    library(MASS)
    set.seed(1234)
    n <- nrow(data)
    ind1 <- sample(c(1:n), round(n*input$train.prop))
    #ind2 <- sample(c(1:n)[-ind1], length(c(1:n)[-ind1]))
    ind2 <- setdiff(c(1:n), ind1)
    
    train.data <- data[ind1,]
    valid.data <- data[ind2,]
    
    #################################
    
    ### fit cart model
    fit.tree <- rpart(Rate~., data = train.data, method = "class")
    
    ### prune the tree
    ptree <- prune(fit.tree, cp = fit.tree$cptable[which.min(fit.tree$cptable[,"xerror"]),"CP"])
    
    ### predict using the validation data on the pruned tree
    pred <- predict(ptree, newdata = valid.data[,-6], type = "class")
    
    ### lda
    
     #lda.model <- lda(train.data[,-6], train.data[,6])
     
     lda.model <- lda(Rate~., data = train.data)
     
    
     lda.pred <- predict(lda.model, newdata = valid.data)
    
    
    ### create a classification table
    
    length(lda.model)
    
    
    x <- pred == valid.data[,6]
    
    CCR <- length(x[x == TRUE])/nrow(valid.data)
    MCR <- 1 - CCR
    
    CR <- c(CCR, MCR)
    
    z <- lda.pred$class == valid.data[,6]
    
    lda.CCR <- length(z[z == TRUE])/nrow(valid.data)
    lda.MCR <- 1 - CCR
    
    lda.CR <- c(lda.CCR, lda.MCR)
    
    y <- cbind(CR, lda.CR)
    
    y <- as.data.frame(y)
    colnames(y) <- c("CART", "LDA")
    rownames(y) <- c("CCR", "MCR")
    y
  })
  
  
  
  
  
  
  
  
  
  
  
  
  
  #############################
  output$table2 <- renderTable({
    table()
    
  },
  rownames = TRUE) 
  
}




#################################################################
shinyApp(ui, server)

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

вот фрагмент моих данных тоже,

«beertax», «jaild», «vmiles», «unrate», «perinc»,»Rate» 1.53937947750092, «нет»,7.23388720703125,14.3999996185303,10544.15234375,1 1.78899073600769,» нет»,7.83634765625,13.6999998092651,10732.7978515625,1 1.71428561210632,» номер»,8.262990234375,11.1000003814697,11108.791015625,1 1.65254235267639, «нет»,8.7269169921875,8.89999961853027,11332.626953125,1 1.60990703105927,» нет»,8.952853515625,9.80000019073486,11661.5068359375,1 1.55999994277954,» нет»,9.1663017578125,7.80000019073486,11944,1 1.50144362449646,» нет»,9.6743232421875,7.19999980926514,12368.6240234375,1 0.214797139167786,» да»,6.81015673828125,9.89999961853027,12309.0693359375,1 0.206422030925751,» да»,6.58749462890625,9.10000038146973,12693.8076171875,1 0.296703308820724,» да»,6.70997021484375,5,13265.93359375,1

Ответ №1:

Использование req() и as.numeric() должно исправить первые две проблемы. Вы должны быть в состоянии исправить последнее после этого.

Редактировать

Изменение select(input$variable) на dplyr::select(input$variable) должно устранить вашу первую ошибку. В вашем списке пакетов есть еще 4 пакета с той же функцией select() ; следовательно, вам нужно указать, из какого пакета вы собираетесь его использовать или загружать dplyr последним.

 df1 <- read.table(text='"beertax","jaild","vmiles","unrate","perinc","Rate"
1.53937947750092,"no",7.23388720703125,14.3999996185303,10544.15234375,1
1.78899073600769,"no",7.83634765625,13.6999998092651,10732.7978515625,1
1.71428561210632,"no",8.262990234375,11.1000003814697,11108.791015625,1
1.65254235267639,"no",8.7269169921875,8.89999961853027,11332.626953125,1
1.60990703105927,"no",8.952853515625,9.80000019073486,11661.5068359375,1
1.55999994277954,"no",9.1663017578125,7.80000019073486,11944,1
1.50144362449646,"no",9.6743232421875,7.19999980926514,12368.6240234375,1
0.214797139167786,"yes",6.81015673828125,9.89999961853027,12309.0693359375,1
0.206422030925751,"yes",6.58749462890625,9.10000038146973,12693.8076171875,1
0.296703308820724,"yes",6.70997021484375,5,13265.93359375,1', header=TRUE, sep=",")

df2 <- df1 %>% transform(Rate=2)
data<- rbind(df1,df2)
data$Rate <- as.factor(data$Rate)

library(shiny)
library(dplyr)
library(ggplot2)
library(markdown)
library(gtsummary)
library(ggdendro)
library(factoextra)
library(mclust)
library(cluster)
library(rpart)
library(rpart.plot)
library(MASS)

ui <- fluidPage(
  navbarPage("Testing Data Exploration",
             tabPanel("Data Exploration",
                      sidebarLayout(
                        sidebarPanel(
                          selectInput("variable",
                                      "Variable",
                                      colnames(data)),
                          selectInput("rate",
                                      "Rate",
                                      levels(data$Rate))
                        ),
                        mainPanel(
                          DTOutput("table1"),
                          plotOutput("plot")
                        )
                      )
             ),
             tabPanel("Classification tools",
                      sidebarLayout(
                        sidebarPanel(
                          sliderInput("train.prop",
                                      "Training data proportion",
                                      min = 0.4,
                                      max = 0.8,
                                      step = 0.1,
                                      value = 0.6),
                          radioButtons("prune",
                                       "Pruning option",
                                       choices = c("view pruned tree",
                                                   "view unpruned tree"))
                        ),
                        mainPanel(
                          DTOutput("table2"),
                          plotOutput("plot2")

                        )
                      )
             )
  )
)


server <- function(input, output) {
  summ <- reactive({
    req(input$variable,input$rate)

    data1 <- data %>%
      filter(Rate == input$rate) %>%
      dplyr::select(input$variable) %>%
      summary() %>%
      as.data.frame() %>%
      tidyr::separate(Freq, c("Stat", "Value"), sep=":") %>%
      tidyr::pivot_wider(names_from = Stat, values_from = Value)
    data2 <- data1[, -c(1,2)]
    data2
  })

  output$table1 <- renderDT({
    summ()
  })

  output$plot <- renderPlot({
    req(input$variable)
    if (input$variable == "jaild" | input$variable == "Rate"){
      ggplot(data, aes(x = Rate, fill = .data[[as.name(input$variable)]]))  
        geom_bar(position = "dodge", width = 0.7)  
        if (input$variable == "Rate"){
          theme(legend.position = "none")
        }
    } else {
      ggplot(data, aes(x = Rate, y = .data[[as.name(input$variable)]], fill = Rate))  
        geom_boxplot()  
        theme(legend.position = "none")
    }
  })

  output$plot2 <- renderPlot({
    req(input$train.prop,input$prune)
    set.seed(1234)
    n <- nrow(data)
    ind1 <- sample(c(1:n), round(n*as.numeric(input$train.prop)))
    ind2 <- sample(c(1:n)[-ind1], length(c(1:n)[-ind1]))


    train.data <- data[ind1,]
    valid.data <- data[ind2,]


    fit.tree <- rpart(Rate~., data = train.data, method = "class")

    ptree <- prune(fit.tree, cp = fit.tree$cptable[which.min(fit.tree$cptable[,"xerror"]),"CP"])

    if (input$prune == "view pruned tree"){
      rpart.plot(ptree, uniform =TRUE)
    } else {
      rpart.plot(fit.tree)
    }
  })
  #######################
  table <- reactive({

    set.seed(1234)
    n <- nrow(data)
    ind1 <- sample(c(1:n), round(n*input$train.prop))
    #ind2 <- sample(c(1:n)[-ind1], length(c(1:n)[-ind1]))
    ind2 <- setdiff(c(1:n), ind1)

    train.data <- data[ind1,]
    valid.data <- data[ind2,]

    #################################

    ### fit cart model
    fit.tree <- rpart(Rate~., data = train.data, method = "class")

    ### prune the tree
    ptree <- prune(fit.tree, cp = fit.tree$cptable[which.min(fit.tree$cptable[,"xerror"]),"CP"])

    ### predict using the validation data on the pruned tree
    pred <- predict(ptree, newdata = valid.data[,-6], type = "class")

    ### lda

    #lda.model <- lda(train.data[,-6], train.data[,6])

    lda.model <- lda(Rate~., data = train.data)


    lda.pred <- predict(lda.model, newdata = valid.data)

    ### create a classification table

    length(lda.model)


    x <- pred == valid.data[,6]

    CCR <- length(x[x == TRUE])/nrow(valid.data)
    MCR <- 1 - CCR

    CR <- c(CCR, MCR)

    z <- lda.pred$class == valid.data[,6]

    lda.CCR <- length(z[z == TRUE])/nrow(valid.data)
    lda.MCR <- 1 - CCR

    lda.CR <- c(lda.CCR, lda.MCR)

    y <- cbind(CR, lda.CR)

    y <- as.data.frame(y)
    colnames(y) <- c("CART", "LDA")
    rownames(y) <- c("CCR", "MCR")
    y
  })

  output$table2 <- renderDT({
    table()
  }, rownames = TRUE)

}

shinyApp(ui, server)

1. Я смог выяснить свои 2 последние ошибки с тех пор, как опубликовал этот вопрос, однако я не смог использовать ваш код для устранения моей первой ошибки. Есть еще идеи? Он по-прежнему выдает ту же ошибку.

2. Возможно, вам следует использовать data[[as.name(input$variable)]] вместо data[[input$variable]] . Пожалуйста, опубликуйте некоторые примеры использования данных dput(head(data)) и отправьте их обратно в свой вопрос, чтобы мы могли проверить вашу проблему.

3. Извините, я не был уверен, как использовать команду dput(head(data)), поэтому я просто сделал скриншот некоторых моих данных. Я обновил свой вопрос своим обновленным кодом и своим скриншотом, если это поможет? Дайте мне знать, если вам нужно больше от меня, пожалуйста

4. О, и я попробовал код данных [[as.name (введите $variable)]] но я все равно получил первую ошибку.

5. возможно, вы можете вставить 10 записей из файла .csv. Снимок экрана не помогает.

Вопрос:

Ответ №1:

Комментарии:

Вам также может понравиться

Ошибки оператора Snowflake и SAS select

Как объединить видео и аудио файлы в ffmpeg-python

Акции Django Oscar не отображают продвигаемые страницы страницы на главную страницу