如何根据 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 (将#修改为@）