The functional neurobiology of dispositions towards negative emotions.

1. library(shiny)
2. library(ggplot2)
3. library(dplyr)
5. # Load the dataframe
6. df <- read.csv("dfDesign.csv")
8. df$outcome <- ifelse(is.na(df$outcome), "Negative Affect", df$outcome)
9. df$outcome <- case_match(df$outcome,
10. "ERLookDiff" ~ "Task-based Ratings",
11. "neoN" ~ "Neuroticism",
12. "neoN1" ~ "N1:Anxiety",
13. "neoN2" ~ "N2:Hostility",
14. "neoN3" ~ "N3:Depression",
15. "neoN4" ~ "N4:Self-Consciousness",
16. "neoN5" ~ "N5:Impulsiveness",
17. "neoN6" ~ "N6:Vulnerability",
18. "NEONother" ~ "N:Other",
19. "NEONX" ~ "N:Other+Self",
20. "PA" ~ "Positive Affect",
21. "Negative Affect" ~ "Negative Affect",
22. "BDI" ~ "BDI",
23. "STAI" ~ "STAI")
25. df$data <- case_match(df$data,
26. "IAPS" ~ "scenes",
27. "PFA" ~ "faces")
29. df$contrast <- case_match(df$contrast,
30. "controlCond" ~ "Neutral Scenes/Shapes",
31. "implBaseline" ~ "Implicit Baseline")
33. df$trainsVsFull <- case_match(df$trainsVsFull,
34. "AHAB" ~ "AHAB2 subsample",
35. "full" ~ "Full Data",
36. "train" ~ "Training Data Only")
38. df$rescale <- case_match(df$rescale,
39. "cente" ~ "Image-wise centering",
40. "nocen" ~ "No image-wise scaling",
41. "zscor" ~ "Image-wise z-scoring")
43. df$algorithm <- case_match(df$algorithm,
44. "pcr" ~ "Principal Component Regression",
45. "pls" ~ "Partial Least Squares",
46. "rf" ~ "Random Forest",
47. "svr" ~ "Support Vector Regression")
49. names(df)[2] <- "task"
50. names(df)[4] <- "data"
54. # Define UI
55. ui <- fluidPage(
56. titlePanel("Dynamic subsetting and plotting of design factor influencing cross-validated correlations"),
57. fluidRow(
58. column(4,
59. h3("Filter Dataframe"),
60. uiOutput("checkboxes_ui")
61. ),
62. column(8,
63. h3("Plot Settings"),
64. selectInput("xvar", "Select X-axis variable:", choices = names(df)[-7]),
65. selectInput("colorvar", "Select Color variable:", choices = c("None", names(df)[-7])),
66. selectInput("facetvar", "Select Facet variable:", choices = c("None", names(df)[-7])),
67. h3("Boxplot"),
68. plotOutput("boxplot")
69. )
70. )
71. )
73. # Define server logic
74. server <- function(input, output, session) {
75. # Generate UI for checkboxes dynamically based on dataframe columns
76. output$checkboxes_ui <- renderUI({
77. checkbox_ui <- lapply(names(df)[-7], function(col) {
78. unique_vals <- unique(df[[col]])
79. checkboxGroupInput(inputId = col,
80. label = paste("Select", col),
81. choices = unique_vals,
82. selected = unique_vals)
83. })
84. do.call(tagList, checkbox_ui)
85. })
87. # Reactive expression to subset dataframe based on checkbox inputs
88. filtered_df <- reactive({
89. sub_df <- df
90. for(col in names(df)[-7]) {
91. if(!is.null(input[[col]])) {
92. sub_df <- sub_df[sub_df[[col]] %in% input[[col]], ]
93. }
94. }
95. return(sub_df)
96. })
98. # Reactive expression to generate the ggplot boxplot
99. output$boxplot <- renderPlot({
100. req(input$xvar)
101. p <- ggplot(filtered_df(), aes_string(x = input$xvar, y = "cvCorr")) +
102. geom_boxplot() +
103. geom_hline(yintercept = 0, color = "grey") +
104. labs(y = "Correlation (cross-validated)", x = input$xvar) +
105. theme_classic() +
106. theme(axis.text.x = element_text(angle = 45, hjust = 1))
108. if (input$colorvar != "None") {
109. p <- p + aes_string(color = input$colorvar)
110. }
112. if (input$facetvar != "None") {
113. p <- p + facet_wrap(as.formula(paste("~", input$facetvar)))
114. }
116. p
117. })
118. }
120. # Run the application
121. shinyApp(ui = ui, server = server)

app.R at commit cd93a0e, no license · at the source