在Rshiny中绘制某些值
我是R和Rshiny编程的新手,目前正在开发一个应用程序,该应用程序基于上传的任何数据库进行主成分分析。我正在寻找一种方法,通过行名对PCA中获得的特征值进行交互式绘图。我在互联网上做了一点研究,通过ggplot我找到了一种获得图的方法,但这是一种静态图,如果我想将特征值的数量更改为图,我必须转到服务器端代码并手动执行,这不是我所有工作的目标。具体来说,我正在寻找一种方法,以我的行名(即我的组件)为函数,对我的所有特征值进行反应性柱状图,并能够选择我想要保留的特征值,如果有人能帮助我,那将是非常棒的 该函数名为output$eigplot 到目前为止,我获得的代码如下所示: UI在Rshiny中绘制某些值,r,shiny,shiny-server,R,Shiny,Shiny Server,我是R和Rshiny编程的新手,目前正在开发一个应用程序,该应用程序基于上传的任何数据库进行主成分分析。我正在寻找一种方法,通过行名对PCA中获得的特征值进行交互式绘图。我在互联网上做了一点研究,通过ggplot我找到了一种获得图的方法,但这是一种静态图,如果我想将特征值的数量更改为图,我必须转到服务器端代码并手动执行,这不是我所有工作的目标。具体来说,我正在寻找一种方法,以我的行名(即我的组件)为函数,对我的所有特征值进行反应性柱状图,并能够选择我想要保留的特征值,如果有人能帮助我,那将是非常
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")
})
})
shinyServer(功能(输入、输出、会话){
###参数名称:
ArgNames您的示例太长太复杂:请参阅,以了解如何制作一个最小的可复制示例。此外,我有点困惑:为什么您的条形图要依赖于行名称?总体而言,以下是我的建议:1)使用玩具数据集(mtcars
,iris
);2)创建(静态)尽可能少地使用代码绘制;3)在闪亮的应用程序中实现此代码以复制静态绘图;4)尝试使某些组件具有反应性如果完成此操作后未成功,请发布使用静态绘图复制闪亮的应用程序所需的代码,并解释绘图的哪些组件应具有反应性。但是,请注意确保文章中的代码尽可能少。不需要一个大的ui
和一个大的server
,只要是必要的