I am a novice in R and Rshiny programming and i'm currently working on an app that does principal components analysis based on any database uploaded. I am looking for a way to make an interactive plot of the eigen values obtained in my PCA by row names. I made my reaserch a little bit on the internet and I found a way to obtain the plot thanks to ggplot, but it is a static plot if I want to change the number of eigen values to plot i would have to go to the server side code and do it manually which is not the goal of all my work.So to be specific, I'm looking for a way to make a reactive barplot of all my eigen values in function of my rownames (that are my components) and be able to choose the eigen values that I want to keep, if anyone could help me it would be great !
the function is named output$eigplot the code that I have obtained so far looks like this :
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")
)))
)
)
))
Server
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")
})
})
