r - 在 Rshiny 中绘制某些值

Question

我是 R 和 Rshiny 编程的新手，我目前正在开发一个基于上传的任何数据库进行主成分分析的应用程序。我正在寻找一种方法来制作通过行名在我的 PCA 中获得的特征值的交互式绘图。我在互联网上进行了一些研究，并通过 ggplot 找到了一种获取绘图的方法，但是如果我想将特征值的数量更改为绘图，则它是一个静态绘图，我必须去服务器端代码并手动完成，这不是我所有工作的目标。所以具体来说，我正在寻找一种方法来根据我的行名（这是我的组件）制作我所有特征值的反应性条形图并成为能够选择我想保留的特征值，如果有人可以帮助我，那就太好了！

该函数名为 output$eigplot 到目前为止我获得的代码如下所示：

用户界面

library(shiny)
library(ggplot2)
library(d3heatmap)
library(DT)

shinyUI(navbarPage(
  "Spectrométrie",
  # Hea

  # Input in sidepanel:
  tabPanel(
    "Données",
    tags$style(type = 'text/css', ".well { max-width: 20em; }"),
    # Tags:
    tags$head(
      tags$style(type = "text/css", "select[multiple] { width: 100%; height:10em}"),
      tags$style(type = "text/css", "select { width: 100%}"),
      tags$style(type = "text/css", "input { width: 19em; max-width:100%}")
    ),
    fluidPage(
      fluidRow(
        column(3,
               selectInput(
                 "readFunction",
                 "Function to read data:",
                 c(
                   # Base R:
                   "read.table","read.csv","read.csv2","read.delim","read.delim2",
                   # foreign functions:
                   "read.spss","read.arff","read.dta","read.dbf","read.epiiinfo",
                   "read.mtp","read.octave","read.ssd","read.xport", "read.systat",
                   # Advanced functions:
                   "scan","readLines"
                 )
               )),
        column(4,
               htmlOutput("ArgSelect")),
        column(4,
               # Argument field:
               htmlOutput("ArgText"))
      ),
      fluidRow(
        column(4, fileInput("file", "Upload data-file:")),
        # Variable selection:
        column(4, htmlOutput("varselect")),
        column(4, textInput("name", "Dataset name:", "Data"))    
      )  
    ),
    mainPanel(dataTableOutput("table"))
  ),
  tabPanel(
    "ACP",
    fluidPage(fluidRow(column(
      12,
      p(
        "Visualisons quelques statistiques descriptives de nos variables :"
      )
    ))),
    mainPanel(
      fluidPage(fluidRow(column(
        12, dataTableOutput("table2", width = "100%")
      ))),
      fluidPage(fluidRow(
        column(6, p("La matrice de corrélations :")),
        d3heatmapOutput("heatmap", width = "100%", height =
                          "1000px")
      )),
      fluidPage(fluidRow(column(
        7, dataTableOutput("coord")
      ))),
      fluidPage(fluidRow(column(
        7, dataTableOutput("contrib")
      ))),
      fluidPage(fluidRow(column(
        7, dataTableOutput("cos2")
      ))),
      fluidPage(fluidRow(column(
        12, plotOutput("eigplot")
      ))),
      fluidPage(fluidRow(column(
        12, plotOutput("indivplot")
      )))
    )
  )
))

服务器

shinyServer(function(input, output,session) {
    ### Argument names:
    ArgNames <- reactive({
        Names <- names(formals(input$readFunction)[-1])
        Names <- Names[Names!="..."]
        return(Names)
    })

    # Argument selector:
    output$ArgSelect <- renderUI({
        if (length(ArgNames())==0) return(NULL)

        selectInput("arg","Argument:",ArgNames())
    })

    ## Arg text field:
    output$ArgText <- renderUI({
        fun__arg <- paste0(input$readFunction,"__",input$arg)

        if (is.null(input$arg)) return(NULL)

        Defaults <- formals(input$readFunction)

        if (is.null(input[[fun__arg]]))
        {
            textInput(fun__arg, label = "Enter value:", value = deparse(Defaults[[input$arg]])) 
        } else {
            textInput(fun__arg, label = "Enter value:", value = input[[fun__arg]]) 
        }
    })


    ### Data import:
    Dataset <- reactive({
        if (is.null(input$file)) {
            # User has not uploaded a file yet
            return(data.frame())
        }

        args <- grep(paste0("^",input$readFunction,"__"), names(input), value = TRUE)

        argList <- list()
        for (i in seq_along(args))
        {
            argList[[i]] <- eval(parse(text=input[[args[i]]]))
        }
        names(argList) <- gsub(paste0("^",input$readFunction,"__"),"",args)

        argList <- argList[names(argList) %in% ArgNames()]

        Dataset <- as.data.frame(do.call(input$readFunction,c(list(input$file$datapath),argList)))
        return(Dataset)
    })

    # Select variables:
    output$varselect <- renderUI({

        if (identical(Dataset(), '') || identical(Dataset(),data.frame())) return(NULL)

        # Variable selection:    
        selectInput("vars", "Variables to use:",
                    names(Dataset()), names(Dataset()), multiple =TRUE)            
    })

    # Show table:
    output$table <- renderDataTable({
        datatable(Dataset()[,input$vars,drop=FALSE], rownames = FALSE)
    })


    output$table2 <- DT::renderDataTable(

        datatable(summary( Dataset()[,input$vars]),
                  rownames = FALSE,
                  options = list(columnDefs = list(list(className = 'dt-center')),
                                 pageLength = 6
                                 )
    ) 
    )

    output$heatmap <- renderD3heatmap({
        dat = Dataset()[,input$vars,drop=FALSE]
        corr = cor(dat)
        return(d3heatmap(corr, scale="column"))
    }) 

    output$fprinc <-DT::renderDataTable({
        dat = Dataset()[,input$vars,drop=FALSE]
        res.pca <- PCA(dat, graph = FALSE)
        u = res.pca["eig"]
        u = as.data.frame(u)
        names(u)[c(1:3)]<-c("valeurs propres", "Pourcentage de la variance", "pourcentage cumulé de la variance")
        datatable(u)
    })

    output$eigplot <- renderPlot({ 
        dat = Dataset()[,input$vars,drop=FALSE]
        res.pca <- PCA(dat, graph = FALSE)
        u = res.pca["eig"]
        u = as.data.frame(u)
        ggplot(u, aes(x=rownames(u), y=u[,2])) + 
            geom_bar(stat="identity", fill="steelblue", color="grey50") + coord_flip() +labs(y="Composantes", x = "% de la variance")
    })

    output$coord <-DT::renderDataTable({
        dat = Dataset()[,input$vars,drop=FALSE]
        res.pca <- PCA(dat, graph = FALSE)
        u = res.pca$var["coord"]
        u = as.data.frame(u)
        datatable(u)
    })

    output$contrib <-DT::renderDataTable({
        dat = Dataset()[,input$vars,drop=FALSE]
        res.pca <- PCA(dat, graph = FALSE)
        u = res.pca$var["contrib"]
        u = as.data.frame(u)
        datatable(u)
    })

    output$cos2 <-DT::renderDataTable({
        dat = Dataset()[,input$vars,drop=FALSE]
        res.pca <- PCA(dat, graph = FALSE)
        u = res.pca$var["cos2"]
        u = as.data.frame(u)
        datatable(u)
    })

    output$indivplot<-renderPlot({
        dat = Dataset()[,input$vars,drop=FALSE]
        res.pca <- PCA(dat, graph = FALSE)
        plot(res.pca, choix = "ind", autoLab = "yes")
    })

    output$cercle<-renderPlot({
        dat = Dataset()[,input$vars,drop=FALSE]
        res.pca <- PCA(dat, graph = FALSE)
        plot(res.pca, choix = "var", autoLab = "yes")
    }) 
})

标签： rshinyshiny-server