如何解决如何根据 RShiny 中的交互式系数阈值从 corrplot 中排除系数
我在 RShiny 中制作了一个仪表板,显示不同列车类型的相关图(使用 corrplot)(基于侧栏中的 inputselect)。现在,我想从相关图中排除低于某个阈值的相关性(即不是基于显着性/p 值,而是基于系数的绝对值)。此阈值应由仪表板用户使用侧栏中的滑块以交互方式设置。
我尝试将系数矩阵中低于 input$slider2 值的值设置为 NA。但是,我似乎没有做对。
我认为问题出在我的代码的服务器部分,因为它没有返回带有矩阵的列表,因此无法在渲染图中正确输入 corrplot 函数:
corr_coeff <- reactive({
if (corr_coeff<input$slider2){corr_coeff<-NA}
})
我的完整代码是:
items <- c( "sfeer1","comfort1","schoon1","veilig1","personeel1","snelheid1","beleving1","ao_trein","ao_reis")
labels <-c( "Thema Sfeer","Thema Comfort","Thema Schoon","Thema Veilig","Thema Personeel","Thema Snelheid","Thema Beleving","Algemeen oordeel trein","Algemeen oordeel reis")
names <- c("VIRM4","ICMm")
#items to include
items_VIRM4 <- subset(VIRM4,select = items)
items_ICMm <- subset(ICMm,select = items)
# add labels
colnames(items_VIRM4) <- labels
colnames(items_ICMm) <- labels
# determine correlations
cor_VIRM4 <- cor(items_VIRM4,use = "complete.obs")
cor_ICMm <- cor(items_ICMm,use = "complete.obs")
corr_coeff <- list(cor_VIRM4,cor_ICMm)
names(corr_coeff) <- names
# Significance test (matrix) which produces p-values and confidence intervals for each pair of input features.
res1_VIRM4 <- cor.mtest(items_VIRM4,conf.level =.95)
res1_ICMm <- cor.mtest(items_ICMm,conf.level =.95)
p_VIRM4 <- res1_VIRM4$p
p_ICMm <- res1_ICMm$p
corr_p <- list(p_VIRM4,p_ICMm)
names(corr_p) <- names
###########################
# Dashboard
###########################
#sidebar
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Correlatie thema's",tabName = "thema",icon = icon("dice-one")),menuItem("Correlatie items",tabName = "items",icon = icon("dice-two")),menuItem("Correlatie interieur",tabName = "interieur",icon = icon("dice-three")),selectInput("Treintype1","Treintype 1:",c("VIRM4","ICMm")),selectInput("Treintype2","Treintype 2:",sliderInput("slider","Significantielevel (p-waarde):",1,0.01),sliderInput("slider2","Grenswaarde coefficienten:",0.1)
)
)
#body
body <- dashboardBody(
tabItems(
tabItem(tabName = "thema",h2("Correlaties op thema's"),Box(title="Correlaties treintype 1",plotOutput("correlation_plot1",height=550),width = 6,height=600),Box(title="Correlaties treintype 2",plotOutput("correlation_plot2",height=600)
),tabItem(tabName = "items",h2("Correlaties op items"),plotOutput("correlation_plot3",height=700),height = 750),plotOutput("correlation_plot4",height = 750)
),h2("item tab content")
)
)
)
#user interface
ui <- dashboardPage(skin = "yellow",dashboardHeader(title = "Correlaties TBO"),sidebar,body)
#server
server <- function(input,output){
corr_coeff <- reactive({
if (corr_coeff<input$slider2){corr_coeff<-NA}
})
output$correlation_plot1 <- renderPlot({
corrplot(corr_coeff[[input$Treintype1]],method="color",type= "lower",tl.col="black",p.mat = corr_p[[input$Treintype1]],sig.level = input$slider,tl.srt=45,addCoef.col = "black",diag=FALSE,insig = "blank",title = input$Treintype1,mar=c(0,0),number.digits=2,na.label = "NA")
})
output$correlation_plot2 <- renderPlot({
corrplot(corr_coeff[[input$Treintype2]],p.mat = corr_p[[input$Treintype2]],title = input$Treintype2,number.digits=2)
})
output$correlation_plot3 <- renderPlot({
corrplot(corr_coeff2[[input$Treintype1]],p.mat = corr_p2[[input$Treintype1]],#addCoef.col = "black",tl.cex=0.7)
})
output$correlation_plot4 <- renderPlot({
corrplot(corr_coeff2[[input$Treintype2]],p.mat = corr_p2[[input$Treintype2]],tl.cex=0.7)
})
}
shinyApp(ui,server)
请注意,corr_coeff 是一个包含多个相关矩阵(每个训练类型一个)的列表。
非常感谢您的帮助!
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。