Skip to content

Commit 407d833

Browse files
nicebreadnicebread
committed
Minor updates
1 parent bd90c4c commit 407d833

File tree

5 files changed

+66
-46
lines changed

5 files changed

+66
-46
lines changed

‎p-hacker/server.R

+23-19
Original file line numberDiff line numberDiff line change
@@ -145,7 +145,7 @@ shinyServer(function(input, output, session) {
145145
})
146146

147147
observeEvent(input$DV_selector_sg, {
148-
dat$DV_selector_sg.chosen <- input$DV_selector_sg
148+
dat$chosen.sg <- input$DV_selector_sg
149149
})
150150

151151
# clear stack pressed
@@ -202,8 +202,8 @@ shinyServer(function(input, output, session) {
202202

203203
# set current and next seed and use it for creating random numbers
204204
#Print(seed)
205-
dat$current_seed = seed
206-
dat$next_seed = seed + 1
205+
dat$current_seed <- seed
206+
dat$next_seed <- seed + 1
207207
set.seed(seed)
208208

209209
# set number of dvs and create labels accordingly
@@ -226,8 +226,8 @@ shinyServer(function(input, output, session) {
226226
# Create matrix of multinomially distributed random numbers
227227
# and convert it to data.frame. Each column represents a dv,
228228
# each row represents a subject.
229-
p <- 0.5
230-
sigma <- matrix(p, nrow=input$dv_n, ncol=input$dv_n)
229+
dv.cor <- 0.2
230+
sigma <- matrix(dv.cor, nrow=input$dv_n, ncol=input$dv_n)
231231
diag(sigma) <- 1.0
232232
dat$allData <- as.data.frame(rmvnorm(n, sigma=sigma))
233233

@@ -538,25 +538,28 @@ shinyServer(function(input, output, session) {
538538
# Subgroup analysis
539539

540540
output$subgroupOutput <- renderUI({
541+
541542

542543
if (nrow(dat$allData) == 0) return()
543544

544545
# split into 6 groups
545-
includedData <- getSelectedRows(dat$allData, dat$selected, dat$DV_selector_sg.chosen)
546+
includedData <- getSelectedRows(dat$allData, dat$selected, dat$chosen)
546547
includedData$ageGroup <- cut(includedData$age, breaks=c(0, median(includedData$age), max(includedData$age)), labels=c("young", "old"))
547548

548-
print(includedData)
549-
550549
subgroupTests <- data.frame()
551550
for (ag in levels(includedData$ageGroup)) {
552551
for (g in levels(includedData$gender)){
552+
553+
print(paste0("Computing ", ag, "/", g))
554+
553555
iD2 <- includedData[includedData$ageGroup == ag & includedData$gender == g, ]
554556

555-
print(iD2)
557+
#print(table(iD2$group))
556558

557-
if (sum(iD2$group == input$label_group1)>2 & sum(iD2$group == input$label_group2)>2) {
559+
# if at least 5 participants are in each cell, compute the ANOVA
560+
if (sum(iD2$group == input$label_group1)>5 & sum(iD2$group == input$label_group2)>5) {
558561

559-
sg.aov <- aov(formula(paste0(dat$DV_selector_sg.chosen, " ~ group")), iD2)
562+
sg.aov <- aov(formula(paste0(dat$chosen, " ~ group")), iD2)
560563

561564
subgroupTests <- rbind(subgroupTests, data.frame(
562565
agegroup = ag,
@@ -567,17 +570,18 @@ shinyServer(function(input, output, session) {
567570
}
568571
}
569572

570-
p1 <- ggplot(includedData, aes_string(x="group", y=dat$DV_selector_sg.chosen)) + geom_point() + facet_grid(gender~ageGroup) + stat_boxplot(geom ='errorbar', data = includedData, color = "grey", width = 0.5) + # draw vertical lines at lower and upper end
571-
geom_boxplot(data = includedData, fill="grey", colour = "grey", alpha = 0.25, outlier.color="red") + # draw boxplot
572-
geom_point(data = includedData, shape = 16, size=4, fill = NA) + # show data points
573-
theme_bw()
573+
print(subgroupTests)
574+
575+
# p1 <- ggplot(includedData, aes_string(x="group", y=dat$chosen)) + geom_point() + facet_grid(gender~ageGroup) + stat_boxplot(geom ='errorbar', data = includedData, color = "grey", width = 0.5) + # draw vertical lines at lower and upper end
576+
# geom_boxplot(data = includedData, fill="grey", colour = "grey", alpha = 0.25, outlier.color="red") + # draw boxplot
577+
# geom_point(data = includedData, shape = 16, size=4, fill = NA) + # show data points
578+
# theme_bw()
574579

575580

576581
return(list(
577-
HTML("PLOT"),
578-
selectInput("DV_selector_sg", label="Choose DV for analysis", c(paste0(DV_PREFIX, 1:input$dv_n), isolate(dat$DV_selector_sg.chosen))),
579-
renderTable(subgroupTests),
580-
renderPlot(p1)
582+
#selectInput("DV_selector_sg", label="Choose DV for analysis", c(paste0(DV_PREFIX, 1:isolate({input$dv_n})), isolate({dat$chosen.sg}))),
583+
renderTable(subgroupTests)#,
584+
#renderPlot(p1)
581585
))
582586
})
583587

‎p-hacker/snippets/about.R renamed to ‎p-hacker/snippets/about.html

+3-5
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
about_panel <- '
21
<!-- ######### ABOUT WELL ######### -->
32

43
<div class="col-sm-3">
@@ -9,18 +8,17 @@ <h4 class="panel-title accordion-toggle">About</h4>
98
</div>
109
<div id="collapse3" class="panel-collapse collapse">
1110
<div class="panel-body">
12-
<i>(c) 2015 by <a href="mailto:felix@nicerbead.de">Felix Schönbrodt</a> (<a href="http://www.nicebread.de">www.nicebread.de</a>). The source code of this app is licensed under the <a href="https://creativecommons.org/licenses/by/4.0/">CC-BY 4.0</a> license and will soon be published on Github.</i>
11+
<i>(c) 2016 by <a href="mailto:felix@nicerbead.de">Felix Schönbrodt</a> (<a href="http://www.nicebread.de">www.nicebread.de</a>). The source code of this app is licensed under the <a href="https://creativecommons.org/licenses/by/4.0/">CC-BY 4.0</a> license and is published on <a href="https://github.com/nicebread/p-hacker">Github</a>.</i>
1312

1413
<h3>Citation</h3>
1514
Programming this app took a considerable effort and amount of time. If you use it in your research or teaching, please consider citing the app:
1615
<br/><br/>
1716

18-
Schönbrodt, F. D. (2015). <i>p-hacker: Train your p-hacking skills!</i> Retrieved from http://shinyapps.org/apps/p-hacker/.
17+
Schönbrodt, F. D. (2016). <i>p-hacker: Train your p-hacking skills!</i> Retrieved from http://shinyapps.org/apps/p-hacker/.
1918
<br/><br/>
2019

2120
</div>
2221
</div>
2322
</div>
2423
</div>
25-
</div>
26-
'
24+
</div>

‎p-hacker/snippets/quick_start.html

+5-2
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
<!-- ######### QUICK START PANEL ######### -->
2-
<div class="col-sm-9">
2+
<div class="col-sm-6">
33
<div class="panel-group" id="accordion">
44
<div class="panel panel-primary">
55
<div class="panel-heading" data-toggle="collapse" data-parent="#accordion" data-target="#collapseOne">
@@ -8,6 +8,9 @@ <h4 class="panel-title accordion-toggle">Manual</h4>
88
<div id="collapseOne" class="panel-collapse collapse">
99
<div class="panel-body">
1010

11+
[For another introduction, see this <a href="http://www.nicebread.de/introducing-p-hacker/">blog post</a>].
12+
<br><br>
13+
1114
<h3>Step 1: The initial sample</h3>
1215
Go to the tab "New study" on the left.
1316

@@ -19,7 +22,7 @@ <h3>Step 1: The initial sample</h3>
1922
<li>Next, decide what the true effect size should be.<br>
2023
<b>Pro-Tip: For a proper training in p-hacking, always select "0"!</b> Then you can train to squeeze out an effect from nothing - isn`t that cool!?
2124
</li>
22-
<li>Next, decide how many potential dependent variables (DVs) you assess. (Technical detail: all DVs correlate to r=.5)<br>
25+
<li>Next, decide how many potential dependent variables (DVs) you assess. (Technical detail: all DVs correlate to r=.2)<br>
2326
<b>Pro-Tip: The more DVs you measure, the more you increase the chance of finding something! DV_all is an aggregate of all DVs.</b>
2427
</li>
2528
<li>

‎p-hacker/snippets/tech_details.html

+17
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,17 @@
1+
<!-- ######### TECHNICAL DETAILS PANEL ######### -->
2+
<div class="col-sm-3">
3+
<div class="panel-group" id="accordion">
4+
<div class="panel panel-primary">
5+
<div class="panel-heading" data-toggle="collapse" data-parent="#accordion" data-target="#collapseTechDetails">
6+
<h4 class="panel-title accordion-toggle">Techical Details</h4>
7+
</div>
8+
<div id="collapseTechDetails" class="panel-collapse collapse">
9+
<div class="panel-body">
10+
<small>
11+
Several DVs are generated which correlate r = .2 to each other (assuming that they roughly tap into the same phenomenon). DV_all is the mean of all DVs. The DVs are drawn from a multivariate normal distribution with mean=0 and SD=1. A standardized mean difference is imposed between groups on each DV corresponding to slider value "True effect (Cohen's d)". A t-test for independent groups is performed on each DV.
12+
</small>
13+
</div>
14+
</div>
15+
</div>
16+
</div>
17+
</div>

‎p-hacker/ui.R

+18-20
Original file line numberDiff line numberDiff line change
@@ -2,9 +2,6 @@ library(shiny)
22
library(shinythemes)
33
library(shinyBS) # Additional Bootstrap Controls
44

5-
# Load the panels with the manual etc.
6-
source("snippets/about.R")
7-
85
shinyUI(fluidPage(theme = shinytheme("spacelab"),
96
tags$head(tags$link(rel="stylesheet", type="text/css", href="accordion.css")),
107

@@ -14,7 +11,8 @@ shinyUI(fluidPage(theme = shinytheme("spacelab"),
1411

1512
div(class="row",
1613
HTML(readFile("snippets/quick_start.html")),
17-
HTML(about_panel)
14+
HTML(readFile("snippets/tech_details.html")),
15+
HTML(readFile("snippets/about.html"))
1816
),
1917

2018
# ---------------------------------------------------------------------
@@ -28,7 +26,7 @@ shinyUI(fluidPage(theme = shinytheme("spacelab"),
2826
textInput("label_group1", "Name for experimental group", "Elderly priming"),
2927
textInput("label_group2", "Name for control group", "Control priming"),
3028
sliderInput("n_per_group", "Initial # of participants in each group", min=2, max=100, value=20, step=1),
31-
sliderInput("true_effect", "True effect in population", min=0, max=1.5, value=0, step=0.05),
29+
sliderInput("true_effect", "True effect (Cohen's d)", min=0, max=1.5, value=0, step=0.05),
3230
sliderInput("dv_n", "Number of DVs", min=2, max=10, value=4, step=1),
3331
actionButton('generateNewData','Run new experiment'),
3432
p("(Discards previous data)"),
@@ -48,16 +46,16 @@ shinyUI(fluidPage(theme = shinytheme("spacelab"),
4846
actionButton('add5','Add 5 new participants'),
4947
actionButton('add10','Add 10 new participants')
5048
)
51-
)# ,
52-
# tabPanel("Expert feature: Subgroup analysis", class="disabled",
53-
# h3("Unlock the expert feature: Subgroup analysis!"),
54-
# checkboxInput("subgroups", "Do an expert subgroup analysis", FALSE)
55-
# )
49+
),
50+
tabPanel("Expert feature: Subgroup analysis", class="disabled",
51+
h3("Unlock the expert feature: Subgroup analysis!"),
52+
checkboxInput("subgroups", "Do an expert subgroup analysis", FALSE)
53+
)
5654
)
5755
),
5856

5957

60-
# ---------------------------------------------------------------------
58+
# --------------------------------------------------------------------
6159
# The output panels, on the right side
6260

6361
column(width=5,
@@ -69,15 +67,15 @@ shinyUI(fluidPage(theme = shinytheme("spacelab"),
6967
click="mainplot_clicked"
7068
),
7169
htmlOutput("plothints")
72-
)#,
73-
# conditionalPanel(
74-
# condition = "input.tabs1 == 'Expert feature: Subgroup analysis'",
75-
# HTML("<h3>Subgroup analysis: Age groups by gender</h3>"),
76-
# conditionalPanel(
77-
# condition = "input.subgroups == 1",
78-
# htmlOutput("subgroupOutput")
79-
# )
80-
# )
70+
),
71+
conditionalPanel(
72+
condition = "input.tabs1 == 'Expert feature: Subgroup analysis'",
73+
HTML("<h3>Subgroup analysis: Age groups by gender</h3>"),
74+
conditionalPanel(
75+
condition = "input.subgroups == 1",
76+
htmlOutput("subgroupOutput")
77+
)
78+
)
8179
),
8280

8381
column(width=3,

0 commit comments

Comments
 (0)