These plots are not designed to work on mobile phones.

Let’s check the calculations in R

To se if this works, let’s compute the ANOVA as I have described it here.

# data
grp1 <- c(1,2,3,4)
grp2 <- c(5,6,7,8)
grp3 <- c(9,10,11,12)

# total SS
total_SS <- sum((df$y - mean(df$y))^2)
total_SS

[1] 143

# within groups SS
within_SS <- sum((c(grp1 - mean(grp1), grp2 - mean(grp2), grp3 - mean(grp3)))^2)
within_SS

[1] 15

# between groups
between_SS <- 4*(sum((c(mean(grp1), mean(grp2), mean(grp3))^2 - mean(df$y)^2)))
between_SS

[1] 128

# check calculation
between_SS + within_SS == total_SS

[1] TRUE

We see that total_SS, between_SS and within_SS are identical to what is shown above in the visualization.

df1 <- 3-1  # number of groups - 1
df2 <- 12 - 3 # N - number of groups
F <-(between_SS/df1) / (within_SS/df2)
F

[1] 38.4

1-pf(F, df1, df2) # p-value

[1] 3.921015e-05

Let’s compare this to anova()

df <- data.frame(y=c(grp1,grp2,grp3))
df$group <- gl(3,4)
anova(lm(y ~ group, df))

Analysis of Variance Table

Response: y
          Df Sum Sq Mean Sq F value    Pr(>F)    
group      2    128  64.000    38.4 3.921e-05 ***
Residuals  9     15   1.667                      
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

We have identical results.

In the article, Nasser outlines three main concerns and suggestions regarding the current criteria for ESTs, which are:

1) Wait-list and placebo control condition does not provide useful information. Instead active control conditions should be used.

2) The EST criteria do not take negative findings into considerations, nor do the criteria provide any provisions for removing treatments from the list. Nasser argues that this could be remedied by including all published findings in a meta-analysis, which would also provide a means of systematically updating the EST lists.

3) ESTs identified in RCTs lack external validity and clinical utility. Nasser’s concern is that trials are neglecting outcomes related to patients’ quality of life, interpersonal and work functioning and so on. The author’s suggestion is that more trials should link “… outcome measures, effect sizes, and statistical and clinical significance to real-life functioning and practical significance”.

I think these points are fair. However, I would like to add that the criteria should take into serious consideration if there is evidence for the proposed mechanism of change. Currently, treatments can claim to be working by magic and still qualify as an EST, even though the improvements seen in patients are obviously mediated by some other mechanism. The classic example of this is Eye Movement Desensitization Therapy—which Nasser mentions—were the active mechanism probably is traditional desensitization. Moreover, I believe that the raw data should be made public before a treatment is considered empirically supported, so that the analyses can be validated and replicated.

Despite the shortcomings of the current EST criteria, I do believe that it is a worthy pursuit—mostly as a type of research synthesis to inform clinicians and decisions-makers. But in the criteria’s current form it is hard to not get the feeling that the epithet of “well-established” is basically meaningless.

Nasser, J. (2013). Empirically Supported Treatments and Efficacy Trials: What Steps Do We Still Need to Take? Journal of Contemporary Psychotherapy DOI: 10.1007/s10879-013-9236-x

In this post I will show how to create such “power plots” using R. Typically, I prefer to use ggplot for plotting, but tasks such as this is one of the few times were I think R’s base graphics have some merit—especially for creating black and white plots, since ggplot does not support using patterns. Thus, I will present code both for ggplot and base graphics.

Creating these plots is pretty straight forwards. You only need to be vaguely familiar with the mechanics of plotting polygons. For instance, say we want to plot a triangle with the following coordinates.

       (2,3)
        /\
       /  \
      /    \
     /      \
(1,2) ------ (3,2)

Then we just specify x and y as vectors, like this:

# ggplot polygon example
ggplot(data.frame(x=c(1,2,3),y=c(2,3,2)), aes(x,y)) + geom_polygon()

So, let us begin by creating the data for the two distributions and three polygons that we will need.

library(ggplot2)
library(grid) # need for arrow()
m1 <- 0  # mu H0
sd1 <- 1.5 # sigma H0
m2 <- 3.5 # mu HA
sd2 <- 1.5 # sigma HA

z_crit <- qnorm(1-(0.05/2), m1, sd1)

# set length of tails
min1 <- m1-sd1*4
max1 <- m1+sd1*4
min2 <- m2-sd2*4
max2 <- m2+sd2*4          
# create x sequence
x <- seq(min(min1,min2), max(max1, max2), .01)
# generate normal dist #1
y1 <- dnorm(x, m1, sd1)
# put in data frame
df1 <- data.frame("x" = x, "y" = y1)
# generate normal dist #2
y2 <- dnorm(x, m2, sd2)
# put in data frame
df2 <- data.frame("x" = x, "y" = y2)

# Alpha polygon
y.poly <- pmin(y1,y2)
poly1 <- data.frame(x=x, y=y.poly)
poly1 <- poly1[poly1$x >= z_crit, ] 
poly1<-rbind(poly1, c(z_crit, 0))  # add lower-left corner

# Beta polygon
poly2 <- df2
poly2 <- poly2[poly2$x <= z_crit,] 
poly2<-rbind(poly2, c(z_crit, 0))  # add lower-left corner

# power polygon; 1-beta
poly3 <- df2
poly3 <- poly3[poly3$x >= z_crit,] 
poly3 <-rbind(poly3, c(z_crit, 0))  # add lower-left corner

# combine polygons. 
poly1$id <- 3 # alpha, give it the highest number to make it the top layer
poly2$id <- 2 # beta
poly3$id <- 1 # power; 1 - beta
poly <- rbind(poly1, poly2, poly3)
poly$id <- factor(poly$id,  labels=c("power","beta","alpha"))

Now that we have all the data that we need, let us create the first plot using ggplot. The annotation is set manually, so it will be a bit tedious to change these plots.

 
# plot with ggplot2
ggplot(poly, aes(x,y, fill=id, group=id)) +
  geom_polygon(show_guide=F, alpha=I(8/10)) +
  # add line for treatment group
  geom_line(data=df1, aes(x,y, color="H0", group=NULL, fill=NULL), size=1.5, show_guide=F) + 
  # add line for treatment group. These lines could be combined into one dataframe.
  geom_line(data=df2, aes(color="HA", group=NULL, fill=NULL),size=1.5, show_guide=F) +
  # add vlines for z_crit
  geom_vline(xintercept = z_crit, size=1, linetype="dashed") +
  # change colors 
  scale_color_manual("Group", 
                     values= c("HA" = "#981e0b","H0" = "black")) +
  scale_fill_manual("test", values= c("alpha" = "#0d6374","beta" = "#be805e","power"="#7cecee")) +
  # beta arrow
  annotate("segment", x=0.1, y=0.045, xend=1.3, yend=0.01, arrow = arrow(length = unit(0.3, "cm")), size=1) +
  annotate("text", label="beta", x=0, y=0.05, parse=T, size=8) +
  # alpha arrow
  annotate("segment", x=4, y=0.043, xend=3.4, yend=0.01, arrow = arrow(length = unit(0.3, "cm")), size=1) +
  annotate("text", label="frac(alpha,2)", x=4.2, y=0.05, parse=T, size=8) +
  # power arrow
  annotate("segment", x=6, y=0.2, xend=4.5, yend=0.15, arrow = arrow(length = unit(0.3, "cm")), size=1) +
  annotate("text", label="1-beta", x=6.1, y=0.21, parse=T, size=8) +
  # H_0 title
  annotate("text", label="H[0]", x=m1, y=0.28, parse=T, size=8) +
  # H_a title
  annotate("text", label="H[a]", x=m2, y=0.28, parse=T, size=8) +
  ggtitle("Statistical Power Plots, Textbook-style") +
  # remove some elements
  theme(panel.grid.minor = element_blank(),
             panel.grid.major = element_blank(),
             panel.background = element_blank(),
             plot.background = element_rect(fill="#f9f0ea"),
             panel.border = element_blank(),
             axis.line = element_blank(),
             axis.text.x = element_blank(),
             axis.text.y = element_blank(),
             axis.ticks = element_blank(),
             axis.title.x = element_blank(),
             axis.title.y = element_blank(),
             plot.title = element_text(size=22))

ggsave("stat_power_ggplot.png", height=8, width=13, dpi=72)

Now, if we want a more “classical looking” black and white-plot, we need to use base graphics.

# example with base graphics
png("stat_power_base.png", width=900, height=600, units="px") # save as png
# reset
plot.new()
# set window size
plot.window(xlim=range(x), ylim=c(-0.01,0.3))
# add polygons
polygon(poly3,  density=10) # 1-beta
polygon(poly2, density=3, angle=-45, lty="dashed") # beta
polygon(poly1, density=10, angle=0) # alpha
# add h_a dist
lines(df2,lwd=3)
# add h_0 dist
lines(df1,lwd=3)
### annotations
# h_0 title
text(m1, 0.3, expression(H[0]), cex=1.5)
# h_a title
text(m2, 0.3, expression(H[a]), cex=1.5)
# beta annotation
arrows(x0=-1, y0=0.045, x1=1, y1=0.01,lwd=2,length=0.15)
text(-1.2, 0.045, expression(beta), cex=1.5)
# beta annotation
arrows(x0=4, y0=-0.01, x1=3.5, y1=0.01, lwd=2, length=0.15)
text(x=4.1, y=-0.015, expression(alpha/2), cex=1.5)
# 1-beta 
arrows(x0=6, y0=0.15, x1=5, y1=0.1, lwd=2,length=0.15)
text(x=7, y=0.155, expression(paste(1-beta, "  (\"power\")")), cex=1.5)
# show z_crit; start of rejection region
abline(v=z_crit)
# add bottom line
abline(h=0)
title("Statistical Power")
dev.off()

Before we get started you need to download a couple of shapefiles that we will use. You can find them here:

• http://www.naturalearthdata.com/downloads/110m-physical-vectors/110m-land/
• http://www.naturalearthdata.com/downloads/110m-cultural-vectors/110m-admin-0-countries/
• http://www.naturalearthdata.com/downloads/110m-cultural-vectors/110m-populated-places/
• ttp://www.naturalearthdata.com/downloads/110m-physical-vectors/110m-graticules/

Put them directly inside your working directory. We will use functions from the rgdal-package to read the shapefiles into R, so if you do not have it, you need to install it before you continue.

library(rgdal)
library(ggplot2)
setwd("/Users/kris/maps_ggplot")

# read shapefile
wmap <- readOGR(dsn="ne_110m_land", layer="ne_110m_land")
# convert to dataframe
wmap_df <- fortify(wmap)

# create a blank ggplot theme
theme_opts <- list(theme(panel.grid.minor = element_blank(),
                        panel.grid.major = element_blank(),
                        panel.background = element_blank(),
                        plot.background = element_rect(fill="#e6e8ed"),
                        panel.border = element_blank(),
                        axis.line = element_blank(),
                        axis.text.x = element_blank(),
                        axis.text.y = element_blank(),
                        axis.ticks = element_blank(),
                        axis.title.x = element_blank(),
                        axis.title.y = element_blank(),
                        plot.title = element_text(size=22)))

# plot map
ggplot(wmap_df, aes(long,lat, group=group)) + 
  geom_polygon() + 
  labs(title="World map (longlat)") + 
  coord_equal() + 
  theme_opts

ggsave("maps/map1.png",  width=12.5, height=8.25, dpi=72)

This will create a longlat-projected world map.

# reproject from longlat to robinson
wmap_robin <- spTransform(wmap, CRS("+proj=robin"))
wmap_df_robin <- fortify(wmap_robin)
ggplot(wmap_df_robin, aes(long,lat, group=group)) + 
  geom_polygon() + 
  labs(title="World map (robinson)") + 
  coord_equal() +
  theme_opts

ggsave("maps/map2.png", width=12.5, height=8.25, dpi=72)

Here the world map is shown using the Robinson projection.

# show hole
ggplot(wmap_df_robin, aes(long,lat, group=group, fill=hole)) +
  geom_polygon() + 
  labs(title="World map (robin)") +
  coord_equal() + 
  theme_opts
ggsave("maps/map3.png", width=12.5, height=8.25, dpi=72)

However, the Caspian sea is missing. This is because of how ggplot handles polygon holes. Ggplot will plot polygon holes as a separate polygon, thus we need to make it pseudo-transparent by changing its fill color.

# change colors
ggplot(wmap_df_robin, aes(long,lat, group=group, fill=hole)) + 
  geom_polygon() + 
  labs(title="World map (Robinson)") + 
  coord_equal() + 
  theme_opts +
  scale_fill_manual(values=c("#262626", "#e6e8ed"), guide="none") # change colors & remove legend

ggsave("maps/map4.png", width=12.5, height=8.25, dpi=72)

Now the Caspian sea is visible.

# add graticule and bounding box (longlat)
grat <- readOGR("ne_110m_graticules_all", layer="ne_110m_graticules_15") 
grat_df <- fortify(grat)

bbox <- readOGR("ne_110m_graticules_all", layer="ne_110m_wgs84_bounding_box") 
bbox_df<- fortify(bbox)

ggplot(bbox_df, aes(long,lat, group=group)) + 
  geom_polygon(fill="white") +
  geom_polygon(data=wmap_df, aes(long,lat, group=group, fill=hole)) + 
  geom_path(data=grat_df, aes(long, lat, group=group, fill=NULL), linetype="dashed", color="grey50") +
  labs(title="World map + graticule (longlat)") + 
  coord_equal() + 
  theme_opts +
  scale_fill_manual(values=c("black", "white"), guide="none") # change colors & remove legend

ggsave("maps/map5.png", width=12.5, height=8.25, dpi=72)

If we want we can also add a graticule and a bounding box. The bounding box is useful if we want to make the sea blue—especially when using some form of curved projection. Here I have added a graticule and bounding box to the longlat-map.

# graticule (Robin)
grat_robin <- spTransform(grat, CRS("+proj=robin"))  # reproject graticule
grat_df_robin <- fortify(grat_robin)
bbox_robin <- spTransform(bbox, CRS("+proj=robin"))  # reproject bounding box
bbox_robin_df <- fortify(bbox_robin)

ggplot(bbox_robin_df, aes(long,lat, group=group)) + 
  geom_polygon(fill="white") +
  geom_polygon(data=wmap_df_robin, aes(long,lat, group=group, fill=hole)) + 
  geom_path(data=grat_df_robin, aes(long, lat, group=group, fill=NULL), linetype="dashed", color="grey50") +
  labs(title="World map (Robinson)") + 
  coord_equal() + 
  theme_opts +
  scale_fill_manual(values=c("black", "white"), guide="none") # change colors & remove legend

ggsave("maps/map6.png", width=12.5, height=8.25, dpi=72)

Robinson projection with added graticule and bounding box.

# add country borders
countries <- readOGR("ne_110m_admin_0_countries", layer="ne_110m_admin_0_countries") 
countries_robin <- spTransform(countries, CRS("+init=ESRI:54030"))
countries_robin_df <- fortify(countries_robin)

ggplot(bbox_robin_df, aes(long,lat, group=group)) + 
  geom_polygon(fill="white") +
  geom_polygon(data=countries_robin_df, aes(long,lat, group=group, fill=hole)) + 
  geom_path(data=countries_robin_df, aes(long,lat, group=group, fill=hole), color="white", size=0.3) +
  geom_path(data=grat_df_robin, aes(long, lat, group=group, fill=NULL), linetype="dashed", color="grey50") +
  labs(title="World map (Robinson)") + 
  coord_equal() + 
  theme_opts +
  scale_fill_manual(values=c("black", "white"), guide="none") # change colors & remove legend

ggsave("maps/map7.png", width=12.5, height=8.25, dpi=72)

Here I have added country borders to the previous map plot.

# bubble plot
places <- readOGR("ne_110m_populated_places", layer="ne_110m_populated_places") 
places_df <- as(places, "data.frame")
places_robin_df <- project(cbind(places_df$LONGITUDE, places_df$LATITUDE), proj="+init=ESRI:54030") 
places_robin_df <- as.data.frame(places_robin_df)
names(places_robin_df) <- c("LONGITUDE", "LATITUDE")
places_robin_df$POP2000 <- places_df$POP2000 

ggplot(bbox_robin_df, aes(long,lat, group=group)) + 
  geom_polygon(fill="white") +
  geom_polygon(data=countries_robin_df, aes(long,lat, group=group, fill=hole)) + 
  geom_point(data=places_robin_df, aes(LONGITUDE, LATITUDE, group=NULL, fill=NULL, size=POP2000), color="#32caf6", alpha=I(8/10)) +
  geom_path(data=countries_robin_df, aes(long,lat, group=group, fill=hole), color="white", size=0.3) +
  geom_path(data=grat_df_robin, aes(long, lat, group=group, fill=NULL), linetype="dashed", color="grey50") +
  labs(title="World map (Robinson)") + 
  coord_equal() + 
  theme_opts +
  scale_fill_manual(values=c("black", "white"), guide="none")+
  scale_size_continuous(range=c(1,20), guide="none")# change colors & remove legend
ggsave("maps/map8.png", width=12.5, height=8.25, dpi=72)

Bubble plots are a popular way of displaying information on maps. Here I used project() to reproject the bubbles’ coordinates into the Robinson projection.

# Winkel tripel projection
countries_wintri <- spTransform(countries, CRS("+proj=wintri"))
bbox_wintri <- spTransform(bbox, CRS("+proj=wintri"))
wmap_wintri <- spTransform(wmap, CRS("+proj=wintri"))
grat_wintri <- spTransform(grat, CRS("+proj=wintri"))

p<-ggplot(bbox_wintri, aes(long,lat, group=group)) + 
  geom_polygon(fill="white") +
  geom_polygon(data=countries_wintri, aes(long,lat, group=group, fill=hole)) + 
  geom_path(data=countries_wintri, aes(long,lat, group=group, fill=hole), color="white", size=0.3) +
  geom_path(data=grat_wintri, aes(long, lat, group=group, fill=NULL), linetype="dashed", color="grey50") +
  labs(title="World map (Winkel Tripel)") + 
  coord_equal(ratio=1) + 
  theme_opts +
  scale_fill_manual(values=c("black", "white"), guide="none") # change colors & remove legend

ggsave(plot=p, "maps/map9.png", width=12.5, height=8.25, dpi=72)

Lastly, here is an example of the Winkel tripel projection. This projection became popular after 1998 when the National Geographic Society choose to use it for their world maps—using it to replace the Robinson projection, which they previously used.

Both functions require a dataframe, containing the parameters that will be used in the power calculations. Here is an example using three groups and three time-points.

# design -------
# mus
CT <- c(34.12, 21, 17.44)
BA <- c(36.88, 16.82, 8.75) 
ADM <- c(35.61, 14.39, 7.78)

study <- data.frame("group" = gl(3,3, labels=c("CT", "BA", "ADM")))
study$time <- gl(3,1,9, labels=c("Intake", "8 weeks", "16 weeks"))

study$DV <- c(CT, BA, ADM) 
study$SD <- 10

ggplot(study, aes(time, DV, group=group, linetype=group, shape=group)) + 
    geom_line() + 
    geom_point()

Here is a plot of our hypothetical study design.

Now, we will use this design to perform a power analysis using anova.pwr.mixed and anova.pwr.mixed.sim.

# analytical ----------
anova.pwr.mixed(data = study, Formula = "DV ~ time*group",
 n=10, m=3, rho=0.5)

   Terms      power n.needed
b  group      0.197       NA
w1 time       1.000       NA
w2 time:group 0.617       NA

# monte carlo ------------
anova.pwr.mixed.sim(data=study, Formula="DV ~ time*group + Error(subjects)",
 FactorA="group", n=10, rho=0.5, sims=100)

       terms power
1  group      0.19
2 time        1.00
3 time:group  0.64

Comparison of analytical and monte carlo power analysis

Now let’s compare the two functions’ results on the time x group-interaction. Hopefully, the two methods will yield the same result.

# compare
samples <- seq(10,50,3) # n's to use
analytical <- matrix(ncol=2, nrow=length(samples))
colnames(analytical) <- c("power", "n")
for(i in samples) { 
  j <- which(samples == i)
  analytical[j,1] <- anova.pwr.mixed(data = study, Formula = "DV ~ time*group", n=i, m=3, rho=0.5)$power[3]
  analytical[j,2] <- i
}
  
MC <- matrix(ncol=2, nrow=length(samples))
colnames(MC) <- c("power", "n")
for(i in samples) { 
  j <- which(samples == i)
  MC[j,1] <- anova.pwr.mixed.sim(data=study, Formula="DV ~ time*group + Error(subjects)", FactorA="group", n=i, rho=0.5, sims=500)$power[3]
  MC[j,2] <- i
}

# plot
MC <- data.frame(MC)
MC$method <- "MC"
analytical <- data.frame(analytical)
analytical$method <- "analytical"
df <- rbind(analytical, MC)

ggplot(df, aes(n, power, group=method, color=method)) + geom_smooth(se=F) + geom_point()

Luckily, the analytical results are consistent with the Monte Carlo results.

References

Faul, F., Erdfelder, E., Lang, A. G., & Buchner, A. (2007). G* Power 3: A flexible statistical power analysis program for the social, behavioral, and biomedical sciences. Behavior research methods, 39(2), 175-191.

Source code

Introduction

The dodo bird verdict is the long held belief by some researchers and clinicians that all psychological interventions produce the same outcome. The proponents of this theory often attribute the efficacy of a therapy to “common factors”, such as the alliance between therapist and client. This is in opposition to crediting the success of a therapy to the specific techniques used by the therapist, e.g. exposure or cognitive restructuring.

It’s no secret that the main rivalry has been between cognitive behavior therapy (CBT) and psychodynamic therapy (PDT) practitioners. However, one of the issues with testing the dodo bird verdict has been the lack of quality studies on the efficacy of PDT. More importantly very few direct comparisons have been made within randomized controlled trails. Therefore it’s always exciting when a research group puts forward precisely that.

The study

Watzke et al. (2012) recruited 189 patients and randomized them to either CBT or PDT, they used a 3:2 ratio because the facilities had less capacity to give PDT. The study took place in a natural setting at an inpatient unit in Germany, and because of the naturalistic setting very broad inclusion criteria were used. The treatments were administered as brief group therapies, with 3-4 sessions per week and an average treatment length of 6 weeks. Both treatment groups additionally received one individual session per week. No treatment manuals were used and the therapists received no special training for this study.

The primary outcome used in the study was the General Severity Index of the Symptom Check list-14 (SCL-14). The secondary outcomes was mental component summary of the SF-8, and the Inventory of Interpersonal Problems (IIP-C). The outcomes were assed at intake and at 6 month follow up.

You can see their results in Figure 1, were I’ve made a plot of the results, and calculated Cohen’s d with 95 % CIs.

Figure 1. A Comparison of Cognitive behavioral therapy (CBT) vs Psychodynamic therapy (PDT) in randomized controlled trail (RCT)

Conclusion

In this direct comparison between CBT and PDT, CBT clearly performed better, and quite convincingly so. Clearly the dodo bird did not fair well in this study, but more research like this is needed before the dodo bird finally can be put to rest. If indeed CBT is more effective than PDT, then this is incredible valuable research for all the patients out there. Hopefully we’ll see more randomized controlled trails that compare two bona fide psychotherapies in the future.

Watzke B, Rüddel H, Jürgensen R, Koch U, Kriston L, Grothgar B, & Schulz H (2012). Longer term outcome of cognitive-behavioural and psychodynamic psychotherapy in routine mental health care: Randomised controlled trial. Behaviour research and therapy, 50 (9), 580-587 PMID: 22750189

Belia, Fidler, Williams, and Cumming (2005) found that researchers in psychology, behavior neuroscience and medicine are really bad at interpreting when error bars signify that two means are significantly different (p = 0.05). What they did was to email a bunch of researchers and invite them to take a web-based test, and they got 473 usable responses. The test consisted of an interactive plot with error bars for two independent groups, the participants were asked to move the error bars to a position they believed would represent a significant t-test at p=0.05. They did this for error bars based on the 95 % CI and the group’s standard errors. The participants did on average set the 95 % CI too far apart with their mean placement corresponding to a p value of .009. They did the opposite with the SE error bars, which they put too close together yielding placements corresponding to p = 0.109. And if you’re wondering they found no difference between the three disciplines.

Plots

I wanted to pull my weight, and I have therefore created some various plots in R that show error bars that are significant at various p-values.

Figure 1. Error bars corresponding to a significant difference at p = .05 (equal group sizes and equal variances)

Figure 2. Error bars corresponding to a significant difference at p = .01 (equal group sizes and equal variances)

Figure 3. Error bars corresponding to a significant difference at p = .001 (equal group sizes and equal variances)

Based on the first plot we see that an overlap of about one third of the 95 % CIs corresponds to p = 0.05. For the SE error bars we see that they are about 1 SE apart when p = 0.05.

R Code

Here’s the complete R code used to produce these plots

library(ggplot2)
library(ggplot2)
library(plyr)
m2 <- 100 # initital group size, should be the same as m1
p <- 1 # starting p-value
m1 <- 100 # mean group 1
sd1 <- 10 # sd group 1
sd2 <- 10 # sd group 2
n <- 20 # n per group
s <- sqrt(0.5 * (sd1^2 + sd2^2)) # pooled sd
while(p>0.05) { # loop til p = 0.05
  t <- (min(c(m1,m2)) - max(c(m1,m2))) / (s * sqrt(2/n)) # t statistics
  df <- (n*2)-2 # degress of freedom
  p <-pt(t, df)*2 # p value
  m2 <- m2 - (m2/10000) # adjust mean for group 2
}
get_CI <- function(x, sd, CI) { # calculate error bars
  se <- sd/sqrt(n) # standard error
  lwr <- c(x - qt((1 + CI)/2, n - 1) * se, x - se) # 95 % CI and SE lower limit
  upr <- c(x + qt((1 + CI)/2, n - 1) * se, x + se) # 95 % CI and SE upper limit
  data.frame("lwr" = lwr, "upr" = upr, "se" = se) # result
}
plot_df <- data.frame("mu" = rep(c(m1,m2), each=2)) # means
plot_df$group <- gl(2,2, labels=c("group1", "group2")) # group factor
plot_df$type <- gl(2,1,4, labels=c("95 % CI", "se errorbars")) # type of errorbar
plot_df <- cbind(plot_df, rbind(get_CI(m1, sd1, .95), get_CI(m2, sd2, .95))) # put it all together

get_overlap <- function(arg) { # calculate overlap %
  x <-subset(plot_df, type == arg) # subset for type of errorbar
  x_range <- abs(mean(x$lwr - x$upr)) # length of error bar
  x_lwr <- max(x$lwr) # lwr limit for group with highest lwr limit
  x_upr <- min(x$upr) # upr limit for group with lowest lwr limit
  overlap <- abs( (x_upr - x_lwr) / x_range) # % overlap
  data.frame("type"=arg, "range" = x_range, "lwr" = x_lwr, "upr" = x_upr, "overlap" = round(overlap, 2)) # result
}
overlap <-ldply(levels(plot_df$type), get_overlap) # get overlap and put into dataframe
overlap$text <- paste(overlap$overlap * 100, "% of errorbar") # label text
overlap$text_y <- c(overlap[1,4], overlap[2,3]) # quick-fix

ggplot(plot_df, aes(group, mu, group=group)) + 
  geom_point(size=3) + # point for group mean
  geom_errorbar(aes(ymax=upr, ymin=lwr), width=0.2) + # error bars for means
  opts(title=paste("Illustration of errorbars for a significant 2-sample t-test, p =", round(p,3))) +  # plot title
  facet_grid(. ~ type) + # split plot after error bar type
  geom_errorbar(data=overlap, aes(ymax=upr, ymin=lwr, x=1.5, y=NULL, group=type), width=0.1, color="red") + # add overlap error bar
  geom_text(data=overlap, aes(label = text, group=type, y=text_y, x=1.5, vjust=-1)) + # annotate overlap
  ylab(expression(bar(x))) # change y label

Belia S, Fidler F, Williams J, & Cumming G (2005). Researchers misunderstand confidence intervals and standard error bars. Psychological methods, 10 (4), 389-96 PMID: 16392994

So what does physicists mean when they report 5-sigma? Well, it’s just another convention of reporting alpha values. Sigma refers to the population standard deviation, and 5-sigma means that they accept events as statistical significant if they fall more than 5 standard deviations away from the mean, given that the null hypothesis is true. And here the null hypothesis is that the event is simply due to random noise or fluctuations. You can get the p-values for 5-sigma by taking the area under the normal curve that’s to the left of +5 sigma.

> pnorm(5)
[1] 0.9999997

And then take 1 – 0.9999997 to get the p-value, which is 0.0000003 as the CERN researchers performed a one-tailed test. I imagine physicists say 5-sigma because saying “point zero zero zero zero zero zero three” might become quite tiresome, so it’s quite ironic that journalist all over the world seem to be converting sigma back to percent.

If we want we can also use R and ggplot2 to illustrate 5-sigma by plotting the normal distribution and superimpose a line at sigma 5

library(ggplot2)
x <- seq(-6,6,length=200) # sigmas
y <- dnorm(x) # curve

df <- data.frame("sigma" = x,"y" = y) # create data frame

# plot
text_block <- "A confidence level = 5-sigma represents \nthe probability of getting a result from your \nexperiment, simply from random fluctuations \nalone, equal to the area under the curve \nthat’s to the right of the dotted line. That’s an \nexceptionally rare event. However, the area to \nthe left of 5-sigma does not represent the \nprobability or certainty that the Higgs boson \nhas been found."
ggplot(df, aes(sigma,y)) +
geom_line(size=1) +
annotate("text", x=1.7, y=0.2, label=text_block, size=4, hjust=0) +
annotate("segment", x = 5, xend=5, y = 0, yend = 0.05, linetype="dashed") +
annotate("text", x=5, y=0.05, label="5-sigma", vjust=-0.5)

Note: The actual plot below has been fine-tuned in Illustrator.

The area under the curve that's to the right of the dotted line represents the p-value for 5-sigma. We see that observations in that area are highly unlikely to occur if we assume that the null hypothesis is true.

I’ve been incredibly busy the last month, amongst other things I’ve moved about 400 miles from Umeå, in the north of sweden, to Stockholm. However, I’ve been working a lot with R and especially with power analysis both via Monte Carlo simulations and via analytical approaches. I will not write about power analysis here, but I will write about a closely related concept about sample size planning for accuracy in parameter estimation (AIPE). Whereas traditional power analysis is used to plan for an adequate sample size to reject the null hypothesis at the desired alpha level, sample size planning for AIPE is used to plan for a desired with of the CI. AIPE functions are implemented in the MBESS-package by Kelly and Lai, if you’re interested you can read more about AIPE in Maxwell, Kelley, and Rausch (2008).

Graphs

Here’s two graphs I did in R to illustrate the connection between sample size and confidence interval. In Figure 2 you can see that that sample size will increase as a function of the width and and the magnitude of the effect, i.e. you need a larger sample to achieve a certain CI width the larger the effect size is. You also see that this increase in sample size is less apparent the larger the CI’s width become.

Figure 1. 95% confidence interval for Cohen’s d of 0.8 in relation to sample size (per group), value above the error bars represent the CI’s range.

Figure 2. 95% confidence interval for different magnitudes of Cohen’s d in relation to sample sizes (per group) and width of confidence intervals.

R code

library(MBESS)
library(ggplot2)

# CI for d = 0.8 ----------------------------------------------------------
smd_plot <- data.frame()
for(i in seq(10,400, by=10)) { # loop
x.ci <- ci.smd(smd=0.8, n.1=i,n.2=i)
smd_plot <- rbind(smd_plot, data.frame("lwr" = x.ci$Lower.Conf.Limit.smd,
"upr" = x.ci$Upper.Conf.Limit.smd, "smd"=0.8, "n" = i))
}
smd_plot$range <- round(smd_plot$upr - smd_plot$lwr,2)

# ggplot --------------------------------------------------------------------

ggplot(smd_plot, aes(n, smd)) +
geom_point() +
geom_errorbar(aes(ymin=lwr, ymax=upr)) +
geom_text(aes(label=range, y=upr), hjust=-0.4, angle=45, size=4) +
scale_y_continuous(breaks=seq(0,2, by=0.25)) +
scale_x_continuous(breaks=seq(0,400, by=20)) +
ylim(-.2,1.8)

# diffrent ds, widths and sample sizes ------------------------------------
ss2 <- NULL
# nested loops to run ss.aie.smd with different deltas and widths
for(j in seq(0.2, 1, by=0.2)) {
ss <- NULL
for(i in seq(0.1,2,by=0.2)) {
ss <- c(ss, ss.aipe.smd(delta=i, width=j))
}
if(j == 0.2) {
ss2 <- data.frame("n" = ss)
ss2$width <- j
} else
{
ss_tmp <- data.frame("n" = ss)
ss_tmp$width <- j
ss2 <- rbind(ss2, ss_tmp)
}
}
ss2$delta <- rep(seq(0.1,2,by=0.2), times=5) # add deltas used in loop

# ggplot ------------------------------------------------------------------
ggplot(ss2, aes(delta, n, group=factor(width), linetype=factor(width))) + geom_line()

References

Cohen J. 1994. The earth is round (p < .05). Am. Psychol. 49(12):997–1003
Maxwell, S. E., Kelley, K., & Rausch, J. R. (2008). Sample size planning for statistical power and accuracy in parameter estimation. Annu. Rev. Psychol., 59, 537-563.

I had this idea that it’d be fun to look at all PubMed’s articles from 2011 and extract country affiliation for each individual country. So I set out to do just that, but in addition to just look at 2011 I also looked at proportional change in publication 1980–2010 for the top 20 countries. The data for 2011 is visualized on a world map both as a bubble plot and as a heat map.

It turned that this project weren’t as straightforward as I first had anticipated. Mainly because PubMed’s affiliation field is a veritable mess with no apparent reporting standard. I imagine there are databases who are much more suited to this task than PubMed.

Method

There were 986 427 articles published in PubMed in 2011; so I, naturally, used R to extract national publication counts. I did this by downloading all citations into one 8.37 Gb XML-file, imported the affiliation strings into MySQL and then used R to extract country affiliation using grep and regular expressions.

To avoid unnecessary manual work I used lists of country names, U.S state & university names, India states and Japan universities. I also looked at word frequencies for the affiliations strings that couldn’t be matched, and used this to make additional pattern lists. Lastly, I also used mail-suffixes to extract affiliation.

Reliability

To find out how many mismatches my script perfomed, I drew a random sample (n = 2000) and manually screened for errors. 22 errors were found, and all of them entailed the string being matched to the correct country plus one incorrect country, i.e. this string were matched to both UK and US (because “Bristol” is matched to UK):

Department of Biotransformation, Bristol-Myers Squibb, Route 206 and Province Line Road, Princeton, NJ 08543, USA. anthony.barros@bms.com

It’s not really a big problem since it only occurs in 1.1 % of the sample. The following countries had erroneous extra matches in my random screening sample:

            x  freq
2    Australia    1
3      Austria    1
4        China    3
5       France    1
6        India    2
7        Japan    1
8         Oman    1
9  Saint Lucia    2
10          UK    8
11         USA    2

Moreover 1.8% of the affiliation strings couldn’t be matched to any country, by analyzing the word frequencies for the unmatched strings, I concluded there didn’t appear to be any words that could be used to identify an significant amount of countries.

Additionally, I compared the number of hits for my top 20 countries to the corresponding hits when searching PubMed using rudimentary country queries. These were the results:

                                                                   search      R PubMed   dif error
1  United States of America[ad] OR United States[ad] OR US[ad] OR USA[ad] 252796 242050 10746  0.04
2                                                               China[ad]  77614  76359  1255  0.02
3                             UK[ad] OR United Kingdom[ad] OR England[ad]  56069  54661  1408  0.03
4                                                               Japan[ad]  51740  48518  3222  0.06
5                                          Germany[ad] OR Deutschland[ad]  48183  44405  3778  0.08
6                                                              Canada[ad]  31926  29386  2540  0.08
7                                                               Italy[ad]  31883  30971   912  0.03
8                                                              France[ad]  31233  28832  2401  0.08
9                                                               Spain[ad]  24901  21268  3633  0.15
10                                                          Australia[ad]  23807  22891   916  0.04
11                                                              Korea[ad]  23796  23778    18  0.00
12                                                              India[ad]  23371  23093   278  0.01
13                                                        Netherlands[ad]  20002  19602   400  0.02
14                                               Brazil[ad] OR Brasil[ad]  18868  18223   645  0.03
15                                                             Taiwan[ad]  12324  12321     3  0.00
16                                                        Switzerland[ad]  11685  10320  1365  0.12
17                                                             Sweden[ad]  11018  10506   512  0.05
18                                                            Belgium[ad]   8551   8146   405  0.05
19                                                             Poland[ad]   7914   6526  1388  0.18

The measurement error is a bit high in countries like Poland, Switzerland and Spain. Nonetheless, I decided to use these PubMed quires to look at annual publications for these countries 1980–2010, using my PubMed trend script

Results

In total 202 countries were extracted, with the publication distribution looking like this:


The same plot as above, but with the bubble size representing publications per capita.

And a plot of the top 20 countries publication percentages 1980–2010

I really don’t know why USA had such a boost in the 1990s, perhaps it got something to do with PubMed’s indexing or maybe it’s a consequence of the “1990s United States boom”? The reason for the sudden increase in US citations in the 90s is that prior to 1995 MEDLINE did only record institution, city, and state including zip code for authors affiliated with the US. So naturally, my queries will miss most US publications prior to 1995. However, the apparent question is: when will china surpass US in scientific output?

PS 1. Thanks to Allan Just for telling me how to extract centroid values from the country polygons.

PS 2. My plan is to do some more in-depth analyzes if this data, e.g. to look at publications per capita (in a vain attempt to increase Sweden’s rankings) and some traditional statistical analysis. Update: Publications per capita added.