0

我在 RShiny 中制作了一个仪表板，显示不同列车类型的相关图（使用 corrplot）（基于侧边栏中的 inputselect）。现在，我想从相关图中排除低于某个阈值的相关性（即不是基于显着性/p 值，而是基于系数的绝对值）。此阈值应由仪表板用户使用侧边栏中的滑块交互式设置。

我试图将系数矩阵中低于 input$slider2 值的值设置为 NA。但是，我似乎没有做对。

我相信问题出在我的代码的服务器部分，因为它没有返回带有矩阵的列表，因此无法在 renderplot 中正确输入 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:", c("VIRM4","ICMm")),
    sliderInput("slider", "Significantielevel (p-waarde):", 0, 1, 0.01),
    sliderInput("slider2", "Grenswaarde coefficienten:", 0, 1, 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=550), width = 6, height=600) 
      ),
    
    tabItem(tabName = "items",
      h2("Correlaties op items"),
      box(title="Correlaties treintype 1", plotOutput("correlation_plot3", height=700), width = 6, height = 750),
      box(title="Correlaties treintype 2", plotOutput("correlation_plot4", height=700), width = 6, height = 750)
      ),
    
    tabItem(tabName = "items",
            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,1,0),
             number.digits=2,
             na.label = "NA") 
  })
  
  output$correlation_plot2 <- renderPlot({
    corrplot(corr_coeff[[input$Treintype2]], method="color",
             type= "lower",
             tl.col="black",
             p.mat = corr_p[[input$Treintype2]],
             sig.level = input$slider,
             tl.srt=45,
             addCoef.col = "black",
             diag=FALSE,
             insig = "blank",
             title = input$Treintype2,
             mar=c(0,0,1,0),
             number.digits=2)
  })
  
  output$correlation_plot3 <- renderPlot({
    corrplot(corr_coeff2[[input$Treintype1]], method="color",
             type= "lower",
             tl.col="black",
             p.mat = corr_p2[[input$Treintype1]],
             sig.level = input$slider,
             tl.srt=45,
             #addCoef.col = "black",
             diag=FALSE,
             insig = "blank",
             title = input$Treintype1,
             mar=c(0,0,1,0),
             number.digits=2,
             tl.cex=0.7) 
  })
  
  output$correlation_plot4 <- renderPlot({
    corrplot(corr_coeff2[[input$Treintype2]], method="color",
             type= "lower",
             tl.col="black",
             p.mat = corr_p2[[input$Treintype2]],
             sig.level = input$slider,
             tl.srt=45,
             #addCoef.col = "black",
             diag=FALSE,
             insig = "blank",
             title = input$Treintype2,
             mar=c(0,0,1,0),
             number.digits=2,
             tl.cex=0.7)
  })
  
}

shinyApp(ui, server)

请注意， corr_coeff 是一个包含多个相关矩阵的列表（每个训练类型一个）。

非常感激你的帮助！

4

0 回答 0