Построение определенных значений в Ршинах - PullRequest
0 голосов
/ 18 февраля 2020

Я новичок в программировании на R и Rshiny, и в настоящее время я работаю над приложением, которое выполняет анализ основных компонентов на основе любой загруженной базы данных. Я ищу способ составить интерактивный график собственных значений, полученных в моем PCA по именам строк. Я немного пересмотрел inte rnet и нашел способ получить график благодаря ggplot, но это график stati c, если я хочу изменить число собственных значений для графика, который у меня будет go к коду на стороне сервера и сделать это вручную, что не является целью всей моей работы. Чтобы указать c, я ищу способ сделать реактивный барплот из всех моих собственных значений в функции из моих имен строк (которые являются моими компонентами) и иметь возможность выбрать собственные значения, которые я хочу сохранить, если кто-нибудь может мне помочь, это было бы здорово!

функция называется output $ eigplot, код, который я получил до сих пор, выглядит следующим образом:

UI

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

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...