在 R shiny 中反应

Question

我是 R shiny 的新手，我打算制作一个关于 PCA 分析的 shiny 应用程序，我想把学校作为我的动态 UI 元素，它可以表示为标准代码R 下面，即本应用程序可以显示 PC 分数、screeplot、biplot 和 proportion/cum.选择不同学校时解释方差的比例。

# 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')

有我的shiny APP代码，报错如下。我不知道为什么它在标准 R 代码中有效，但不适用于闪亮的代码。你能帮我修一下吗？非常感谢。

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')
    })
  
  

})

Answer 1

我整理了您的应用，使其更符合应有的外观。我不喜欢使用在线文件，所以我在这个例子中使用了 mtcars。使用 req() 是个好主意，这样函数才能运行直到一切准备就绪。

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)

在 R shiny 中反应

Reactive in R shiny

plot

r

pca

shiny

reactive