I'm currently working on an Rshiny webapp to use for some simple classification. Currently, I've been working on creating a table that contains the CCR and MCR of both the CART and LDA methods on the data. My aim is then to highlight the column of the MCR and CCR of the best method (the method with the highest CCR... or lowest MCR). I have ran the code and viewed that it works correctly using the Viewer Pane. However, when I load the app, I obtain the error 'data' must be 2-dimensional (e.g. data frame or matrix).
Here is my code:
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(DT)
#library(MASS)
glimpse(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(
DTOutput("table2"),
plotOutput("plot2")
)
)
)
)
)
#################################################################
server <- function(input, output) {
output$table <- renderTable({
req(input$variable,input$rate)
data <- 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)
data <- data[, -c(1,2)]
})
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)
}
})
output$table2 <- DT::renderDT({
library(MASS)
set.seed(1234)
n <- nrow(data)
ind1 <- sample(c(1:n), round(n*0.6))
#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[,-6])
### 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 - lda.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
DT::datatable(y, options=list(dom = "t")) %>%
formatRound(columns = c(1,2), digits = 6) %>%
formatStyle(columns = colnames(y[which.max(y[1,])]), background = "green")
#colnames(y[1])
#colnames(y[which.max(y[1,])])
},
rownames = TRUE)
}
?formatStyle
?formatRound()
#################################################################
shinyApp(ui, server)
and here is some of my data:
"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
0.381355941295624,"yes",6.7712626953125,6.5,13726.6953125,1
0.371517032384872,"yes",8.1290078125,6.90000009536743,14107.3271484375,1
0.360000014305115,"yes",9.370654296875,6.19999980926514,14241,1
0.346487015485764,"yes",9.815720703125,6.30000019073486,14408.0849609375,1
0.650358021259308,"no",7.20850048828125,9.80000019073486,10267.302734375,1
0.67545872926712,"no",7.1759169921875,10.1000003814697,10433.486328125,1
0.598901093006134,"no",7.08481982421875,8.89999961853027,10916.4833984375,1
0.577330529689789,"no",7.25391796875,8.69999980926514,11149.3642578125,1
0.562435507774353,"no",7.4689990234375,8.69999980926514,11399.380859375,1
0.545000016689301,"no",7.66583056640625,8.10000038146973,11537,1
0.52454286813736,"no",8.02462548828125,7.69999980926514,11760.3466796875,1
0.107398569583893,"no",6.8586767578125,9.89999961853027,15797.1357421875,0
0.103211015462875,"no",7.21629150390625,9.69999980926514,15970.18359375,0
0.0989011004567146,"no",7.61917578125,7.80000019073486,16590.109375,0
0.0953389853239059,"no",7.87406689453125,7.19999980926514,16985.169921875,0
0.0928792580962181,"no",8.03491015625,6.69999980926514,17356.037109375,0
0.0900000035762787,"no",8.18063330078125,5.80000019073486,17846,0
0.0866217538714409,"no",8.531990234375,5.30000019073486,18049.0859375,0
0.214797139167786,"no",7.742841796875,7.69999980926514,15082.3388671875,1
0.206422030925751,"no",7.65606298828125,6.59999990463257,15131.880859375,1
0.197802200913429,"no",7.7078525390625,5.59999990463257,15486.8134765625,0
0.190677970647812,"no",8.09220947265625,5.90000009536743,15569.9150390625,0
0.185758516192436,"no",8.13137451171875,7.40000009536743,15616.0986328125,0
0.180000007152557,"no",8.18202783203125,7.69999980926514,15605,0
0.173243507742882,"no",8.3807685546875,6.40000009536743,15845.04296875,0
0.224343672394753,"no",6.4400537109375,6.90000009536743,17255.369140625,0
0.233563080430031,"no",6.57004296875,6,17744.265625,0
0.248010993003845,"no",6.68019287109375,4.59999990463257,18760.439453125,0
0.239078402519226,"yes",6.97921484375,4.90000009536743,19312.5,0
I know the code works properly - I just want it to be able to run properly on the app. Please help!
