I am new to R shiny and I am going to make a shiny app about the PCA analysis and I want to make the school as my dynamic UI elements, which can be expressed as the standard code in R below, that is, this app can show the PC scores, screeplot, biplot and proportion/cum.proportion of explained variance when choosing different schools.
# Read the data
temp <- tempfile()
download.file("http://archive.ics.uci.edu/ml/machine-learning-databases/00356/student.zip",temp, mode="wb")
unzip(temp, "student-mat.csv")
math <- read.table("student-mat.csv",sep= ";", header= T)
unlink(temp)
(math <- as_tibble(math))
# Read the data for school "GP"
math.GP <- read.table("student-mat.csv",sep= ";", header= T) %>% filter(school == "GP")
# PCA Scores
PCs <- prcomp(select(math.GP, G3, G1, G2, absences, studytime),
center = TRUE, scale = TRUE)
PCs
# Biplot
biplot(PCs, xlabs = rep(".", nrow(math.GP)), cex = 1.2)
# Screeplot
screeplot(PCs, type = "lines")
# Explained Proportion VS Cum. Proportion
par(mfrow = c(1, 2))
plot(PCs$sdev^2/sum(PCs$sdev^2), xlab = "Principal Component",
ylab = "Proportion of Variance Explained", ylim = c(0, 1), type = 'b')
plot(cumsum(PCs$sdev^2/sum(PCs$sdev^2)), xlab = "Principal Component",
ylab = "Cum. Prop of Variance Explained", ylim = c(0, 1), type = 'b')
# Read the data for school "GP"
math.MS <- read.table("student-mat.csv",sep= ";", header= T) %>% filter(school == "MS")
head(math)
# PC Scores
PCs <- prcomp(select(math.MS, G3, G1, G2, absences, studytime), center = TRUE, scale = TRUE)
PCs
# Biplot
biplot(PCs, xlabs = rep(".", nrow(math.MS)), cex = 1.2)
# Screeplot
screeplot(PCs, type = "lines")
par(mfrow = c(1, 2))
plot(PCs$sdev^2/sum(PCs$sdev^2), xlab = "Principal Component",
ylab = "Proportion of Variance Explained", ylim = c(0, 1), type = 'b')
plot(cumsum(PCs$sdev^2/sum(PCs$sdev^2)), xlab = "Principal Component",
ylab = "Cum. Prop of Variance Explained", ylim = c(0, 1), type = 'b')
There is my code for shiny APP and the error is shown below. I do not know why it works during the standard R code but not work for the shiny code. Could you please help me fix it? Thanks so much.
library(shiny)
library(shinythemes)
temp <- tempfile()
download.file("http://archive.ics.uci.edu/ml/machine-learning-databases/00356/student.zip",temp, mode="wb")
unzip(temp, "student-mat.csv")
math <- read.table("student-mat.csv",sep= ";", header= T)
unlink(temp)
(math <- as_tibble(math))
shinyUI(fluidPage(
headerPanel(h1("PRINCIPLE COMPONENT ANALYSIS")),
# Sidebar with options for the two schools
sidebarLayout(
sidebarPanel(
h3("Select the Schools:"),
selectizeInput("school", "School", selected = "GP",
choices = levels(as.factor(math$school)))
),
mainPanel(
tabsetPanel(
tabPanel("PC_Scores",verbatimTextOutput("scores")),
tabPanel("PC_Scree_PLot",plotOutput("screePlot")),
tabPanel("Bi_Plot",plotOutput("biplot")),
tabPanel("Proportion of Variance Explained vs
Cum. Proportion of Variance Explained"),
plotOutput("explain"))
)))
)
library(shiny)
library(dplyr)
temp <- tempfile()
download.file("http://archive.ics.uci.edu/ml/machine-learning-databases/00356/student.zip",temp, mode="wb")
unzip(temp, "student-mat.csv")
math <- read.table("student-mat.csv",sep= ";", header= T)
unlink(temp)
(math <- as_tibble(math))
shinyServer(function(input,output,session) {
math <- reactive({
newDat <- math %>% filter(school == input$school) %>%
select(G1, G2, G3, absences, studytime)
})
output$scores <- renderPrint({
X <- math()
pca <- princomp(X, center = TRUE, scale = TRUE)
pca$scores
})
output$screeplot<-renderPlot(
{
data <- math()
dat <- princomp(data, center = TRUE, scale = TRUE)
screeplot(dat, type = "lines")
})
output$biplot<-renderPlot(
{
data <- math()
dat <- princomp(data, center = TRUE, scale = TRUE)
biplot(dat, xlabs = rep(".", nrow(data)), cex = 1.2)
})
output$explain <- renderPlot(
{
data <- math()
dat <- princomp(data, center = TRUE, scale = TRUE)
par(mfrow = c(1, 2))
plot(dat$sdev^2/sum(PCs$sdev^2), xlab = "Principal Component",
ylab = "Proportion of Variance Explained", ylim = c(0, 1), type = 'b')
plot(cumsum(dat$sdev^2/sum(PCs$sdev^2)), xlab = "Principal Component",
ylab = "Cum. Prop of Variance Explained", ylim = c(0, 1), type = 'b')
})
})
I tidied up your app to bring it more inline with what it should look like. I wasn't keen on using files from online, so I used mtcars in this example. It's a good idea to use req() so functions can't run until everything is ready for them.
library(shiny)
library(shinythemes)
library(dplyr)
ui <- shinyUI(fluidPage(
headerPanel(h1("PRINCIPLE COMPONENT ANALYSIS")),
# Sidebar with options for the two schools
sidebarLayout(
sidebarPanel(
h3("Select the Schools:"),
selectizeInput("school", "School", choices = NULL)
),
mainPanel(
tabsetPanel(
tabPanel("PC_Scores", verbatimTextOutput("scores")),
tabPanel("PC_Scree_PLot", plotOutput("screePlot")),
tabPanel("Bi_Plot", plotOutput("biplot")),
tabPanel("Proportion of Variance Explained vs Cum. Proportion of Variance Explained", plotOutput("explain")))
)))
)
server <- shinyServer(function(input,output,session) {
# data import, uses ths to populate drop-down and to sub-set for PCA
dat <- reactive({ as_tibble(mtcars, rownames = "model") })
math <- reactive({
req(dat())
dat() %>%
filter(cyl == as.numeric(input$school)) %>%
select(mpg, disp, hp)
})
observe({
updateSelectInput(session, "school",
choices = as.character(unique(dat()$cyl)),
selected = "4")
})
output$scores <- renderPrint({
req(math())
pca <- princomp(math(), center = TRUE, scale = TRUE)
pca$scores
})
output$screePlot<-renderPlot({
req(math())
dat <- princomp(math(), center = TRUE, scale = TRUE)
screeplot(dat, type = "lines")
})
output$biplot <- renderPlot({
req(math())
dat <- princomp(math(), center = TRUE, scale = TRUE)
biplot(dat, xlabs = rep(".", nrow(math())), cex = 1.2)
})
output$explain <- renderPlot({
req(math())
dat <- princomp(math(), center = TRUE, scale = TRUE)
par(mfrow = c(1, 2))
plot(dat$sdev^2/sum(PCs$sdev^2), xlab = "Principal Component",
ylab = "Proportion of Variance Explained", ylim = c(0, 1), type = 'b')
plot(cumsum(dat$sdev^2/sum(PCs$sdev^2)), xlab = "Principal Component",
ylab = "Cum. Prop of Variance Explained", ylim = c(0, 1), type = 'b')
})
})
# Run the application
shinyApp(ui = ui, server = server)