How to deploy experiment:
library(ggplot2)
library(reshape2)
#' @name assign_vector
#' @param data A vector of data to perform the t-test on.
#' @param n An integer indicating the number of t-tests to perform. Default is 1000
#' @return A data frame in "tall" format
assign_vector <- function(data, n = 1000) {
# replicate the call to shapiro.
#test n times to build up a vector of p-values
p.5 <- replicate(n=n, expr=shapiro.test(sample(my.data, 5, replace=TRUE))$p.value)
p.10 <- replicate(n=n, expr=shapiro.test(sample(my.data, 10, replace=TRUE))$p.value)
p.1000 <- replicate(n=n, expr=shapiro.test(sample(my.data, 1000, replace=TRUE))$p.value)
#' Combine the data into a data frame,
#' one column for each number of samples tested.
p.df <- cbind(p.5, p.10, p.1000)
p.df <- as.data.frame(p.df)
colnames(p.df) <- c("5 samples","10 samples","1000 samples")
#' Put the data in "tall" format, one column for number of samples
#' and one column for the p-value.
p.df.m <- melt(p.df)
#' Make sure the levels are sorted correctly.
p.df.m <- transform(p.df.m, variable = factor(variable, levels = c("5 samples","10 samples","1000 samples")))
return(p.df.m)
}
n.rand <- 100000
n.test <- 10000
my.data <- rnorm(n.rand)
p.df.m <- assign_vector(my.data, n = n.test)
No id variables; using all as measure variables
#plot the p-values
ggplot(p.df.m, aes(x = value)) +
geom_histogram(binwidth = 1/10) +
facet_grid(facets=variable ~ ., scales="free_y") +
xlim(0,1) +
ylab("Count of p-values") +
xlab("p-values") +
theme(text = element_text(size = 16))

#check out the distribution. What do you notice?
ggplot(NULL, aes(x=x, colour = distribution)) +
stat_function(fun=dnorm, data = data.frame(x = c(-6,6), distribution = factor(1))) +
stat_function(fun=dt, args = list( df = 20), data = data.frame(x = c(-6,6), distribution = factor(2)), linetype = "dashed") +
scale_colour_manual(values = c("blue","red"), labels = c("Normal","T-Distribution"))

my.data <- rt(n.rand, df = 20)
p.df.m <- assign_vector(my.data, n = n.test)
No id variables; using all as measure variables
ggplot(p.df.m, aes(x = value)) +
geom_histogram(binwidth = 1/10) +
facet_grid(facets=variable ~ ., scales="free_y") +
xlim(0,1) +
ylab("Count of p-values") +
xlab("p-values") +
theme(text = element_text(size = 16))

my.data <- rt(n.rand, df = 20)
my.data.2 <- rnorm(n.rand)
# Trim off the tails
my.data <- my.data[which(my.data < 3 & my.data > -3)]
# Add in tails from the other distribution
my.data <- c(my.data, my.data.2[which(my.data.2 < -3 | my.data.2 > 3)])
p.df.m <- assign_vector(my.data, n = n.test)
No id variables; using all as measure variables
ggplot(p.df.m, aes(x = value)) +
geom_histogram(binwidth = 1/10) +
facet_grid(facets=variable ~ ., scales="free_y") +
xlim(0,1) +
ylab("Count of p-values") +
xlab("p-values") +
theme(text = element_text(size = 16))

my.data <- rnorm(n.rand)
my.data.2 <- rt(n.rand, df = 20)
# Trim off the tails
my.data <- my.data[which(my.data < 3 & my.data > -3)]
# Add in tails from the other distribution
my.data <- c(my.data, my.data.2[which(my.data.2 < -3 | my.data.2 > 3)])
p.df.m <- assign_vector(my.data, n = n.test)
No id variables; using all as measure variables
ggplot(p.df.m, aes(x = value)) +
geom_histogram(binwidth = 1/10) +
facet_grid(facets=variable ~ ., scales="free_y") +
xlim(0,1) +
ylab("Count of p-values") +
xlab("p-values") +
theme(text = element_text(size = 16))

my.data <- rlnorm(n.rand, 0, 0.4)
p.df.m <- assign_vector(my.data, n = n.test)
No id variables; using all as measure variables
ggplot(p.df.m, aes(x = value)) +
geom_histogram(binwidth = 1/10) +
facet_grid(facets=variable ~ ., scales="free_y") +
xlim(-0.05,1.05) +
ylab("Count of p-values") +
xlab("p-values") +
theme(text = element_text(size = 16))

hist(my.data)

LS0tDQp0aXRsZTogIlN0YXRpc3RpY2FsIFRlc3RpbmctTVNEUzY1MCINCmF1dGhvcjogIkphY2x5biBCYXpzaWthIg0KZm9udC1mYW1pbHk6ICdHZW9yZ2lhJw0KZGF0ZTogImByIFN5cy5EYXRlKClgIg0Kb3V0cHV0OiBodG1sX25vdGVib29rDQotLS0NCg0KICAgICAgDQoNCg0KIVtdKGh0dHBzOi8vYW5lYzcuZmlsZXMud29yZHByZXNzLmNvbS8yMDE2LzA5L3N0YXRzLXdvcmRjbG91ZC5qcGcpDQoNCg0KDQoNCiMjSG93IHRvIGRlcGxveSBleHBlcmltZW50Og0KDQpgYGB7cn0NCmxpYnJhcnkoZ2dwbG90MikNCmxpYnJhcnkocmVzaGFwZTIpDQoNCmBgYA0KDQpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRX0NCmtuaXRyOjpvcHRzX2NodW5rJHNldChlY2hvID0gVFJVRSkNCmBgYA0KDQpgYGB7cn0NCg0KIycgQG5hbWUgYXNzaWduX3ZlY3Rvcg0KIycgQHBhcmFtIGRhdGEgQSB2ZWN0b3Igb2YgZGF0YSB0byBwZXJmb3JtIHRoZSB0LXRlc3Qgb24uDQojJyBAcGFyYW0gbiBBbiBpbnRlZ2VyIGluZGljYXRpbmcgdGhlIG51bWJlciBvZiB0LXRlc3RzIHRvIHBlcmZvcm0uIERlZmF1bHQgaXMgMTAwMA0KIycgQHJldHVybiBBIGRhdGEgZnJhbWUgaW4gInRhbGwiIGZvcm1hdA0KYXNzaWduX3ZlY3RvciA8LSBmdW5jdGlvbihkYXRhLCBuID0gMTAwMCkgew0KIyByZXBsaWNhdGUgdGhlIGNhbGwgdG8gc2hhcGlyby4NCiN0ZXN0IG4gdGltZXMgdG8gYnVpbGQgdXAgYSB2ZWN0b3Igb2YgcC12YWx1ZXMNCiAgcC41IDwtIHJlcGxpY2F0ZShuPW4sIGV4cHI9c2hhcGlyby50ZXN0KHNhbXBsZShteS5kYXRhLCA1LCByZXBsYWNlPVRSVUUpKSRwLnZhbHVlKQ0KICBwLjEwIDwtIHJlcGxpY2F0ZShuPW4sIGV4cHI9c2hhcGlyby50ZXN0KHNhbXBsZShteS5kYXRhLCAxMCwgcmVwbGFjZT1UUlVFKSkkcC52YWx1ZSkNCiAgcC4xMDAwIDwtIHJlcGxpY2F0ZShuPW4sIGV4cHI9c2hhcGlyby50ZXN0KHNhbXBsZShteS5kYXRhLCAxMDAwLCByZXBsYWNlPVRSVUUpKSRwLnZhbHVlKQ0KIycgQ29tYmluZSB0aGUgZGF0YSBpbnRvIGEgZGF0YSBmcmFtZSwgDQojJyBvbmUgY29sdW1uIGZvciBlYWNoIG51bWJlciBvZiBzYW1wbGVzIHRlc3RlZC4NCiAgcC5kZiA8LSBjYmluZChwLjUsIHAuMTAsIHAuMTAwMCkNCiAgcC5kZiA8LSBhcy5kYXRhLmZyYW1lKHAuZGYpDQogIGNvbG5hbWVzKHAuZGYpIDwtIGMoIjUgc2FtcGxlcyIsIjEwIHNhbXBsZXMiLCIxMDAwIHNhbXBsZXMiKQ0KIycgUHV0IHRoZSBkYXRhIGluICJ0YWxsIiBmb3JtYXQsIG9uZSBjb2x1bW4gZm9yIG51bWJlciBvZiBzYW1wbGVzDQojJyBhbmQgb25lIGNvbHVtbiBmb3IgdGhlIHAtdmFsdWUuDQogIHAuZGYubSA8LSBtZWx0KHAuZGYpDQojJyBNYWtlIHN1cmUgdGhlIGxldmVscyBhcmUgc29ydGVkIGNvcnJlY3RseS4NCiAgcC5kZi5tIDwtIHRyYW5zZm9ybShwLmRmLm0sIHZhcmlhYmxlID0gZmFjdG9yKHZhcmlhYmxlLCBsZXZlbHMgPSBjKCI1IHNhbXBsZXMiLCIxMCBzYW1wbGVzIiwiMTAwMCBzYW1wbGVzIikpKQ0KICByZXR1cm4ocC5kZi5tKSAgDQp9DQpgYGANCg0KYGBge3J9DQoNCm4ucmFuZCA8LSAxMDAwMDANCm4udGVzdCA8LSAxMDAwMA0KbXkuZGF0YSA8LSBybm9ybShuLnJhbmQpDQpwLmRmLm0gPC0gYXNzaWduX3ZlY3RvcihteS5kYXRhLCBuID0gbi50ZXN0KQ0KYGBgDQoNCmBgYHtyfQ0KI3Bsb3QgdGhlIHAtdmFsdWVzIA0KZ2dwbG90KHAuZGYubSwgYWVzKHggPSB2YWx1ZSkpICsgDQogIGdlb21faGlzdG9ncmFtKGJpbndpZHRoID0gMS8xMCkgKyANCiAgZmFjZXRfZ3JpZChmYWNldHM9dmFyaWFibGUgfiAuLCBzY2FsZXM9ImZyZWVfeSIpICsgDQogIHhsaW0oMCwxKSArDQogIHlsYWIoIkNvdW50IG9mIHAtdmFsdWVzIikgKw0KICB4bGFiKCJwLXZhbHVlcyIpICsNCiAgdGhlbWUodGV4dCA9IGVsZW1lbnRfdGV4dChzaXplID0gMTYpKQ0KYGBgDQoNCmBgYHtyfQ0KI2NoZWNrIG91dCB0aGUgZGlzdHJpYnV0aW9uLiBXaGF0IGRvIHlvdSBub3RpY2U/DQpnZ3Bsb3QoTlVMTCwgYWVzKHg9eCwgY29sb3VyID0gZGlzdHJpYnV0aW9uKSkgKyANCiAgc3RhdF9mdW5jdGlvbihmdW49ZG5vcm0sIGRhdGEgPSBkYXRhLmZyYW1lKHggPSBjKC02LDYpLCBkaXN0cmlidXRpb24gPSBmYWN0b3IoMSkpKSArIA0KICBzdGF0X2Z1bmN0aW9uKGZ1bj1kdCwgYXJncyA9IGxpc3QoIGRmID0gMjApLCBkYXRhID0gZGF0YS5mcmFtZSh4ID0gYygtNiw2KSwgZGlzdHJpYnV0aW9uID0gZmFjdG9yKDIpKSwgbGluZXR5cGUgPSAiZGFzaGVkIikgKyANCiAgc2NhbGVfY29sb3VyX21hbnVhbCh2YWx1ZXMgPSBjKCJibHVlIiwicmVkIiksIGxhYmVscyA9IGMoIk5vcm1hbCIsIlQtRGlzdHJpYnV0aW9uIikpDQpgYGANCg0KYGBge3J9DQpteS5kYXRhIDwtIHJ0KG4ucmFuZCwgZGYgPSAyMCkNCmBgYA0KDQpgYGB7cn0NCnAuZGYubSA8LSBhc3NpZ25fdmVjdG9yKG15LmRhdGEsIG4gPSBuLnRlc3QpDQpnZ3Bsb3QocC5kZi5tLCBhZXMoeCA9IHZhbHVlKSkgKyANCiAgZ2VvbV9oaXN0b2dyYW0oYmlud2lkdGggPSAxLzEwKSArIA0KICBmYWNldF9ncmlkKGZhY2V0cz12YXJpYWJsZSB+IC4sIHNjYWxlcz0iZnJlZV95IikgKyANCiAgeGxpbSgwLDEpICsNCiAgeWxhYigiQ291bnQgb2YgcC12YWx1ZXMiKSArDQogIHhsYWIoInAtdmFsdWVzIikgKw0KICB0aGVtZSh0ZXh0ID0gZWxlbWVudF90ZXh0KHNpemUgPSAxNikpDQpgYGANCg0KYGBge3J9DQpteS5kYXRhIDwtIHJ0KG4ucmFuZCwgZGYgPSAyMCkNCm15LmRhdGEuMiA8LSBybm9ybShuLnJhbmQpDQojIFRyaW0gb2ZmIHRoZSB0YWlscw0KbXkuZGF0YSA8LSBteS5kYXRhW3doaWNoKG15LmRhdGEgPCAzICYgbXkuZGF0YSA+IC0zKV0NCiMgQWRkIGluIHRhaWxzIGZyb20gdGhlIG90aGVyIGRpc3RyaWJ1dGlvbg0KbXkuZGF0YSA8LSBjKG15LmRhdGEsIG15LmRhdGEuMlt3aGljaChteS5kYXRhLjIgPCAtMyB8IG15LmRhdGEuMiA+IDMpXSkNCmBgYA0KDQoNCmBgYHtyfQ0KcC5kZi5tIDwtIGFzc2lnbl92ZWN0b3IobXkuZGF0YSwgbiA9IG4udGVzdCkNCmdncGxvdChwLmRmLm0sIGFlcyh4ID0gdmFsdWUpKSArIA0KICBnZW9tX2hpc3RvZ3JhbShiaW53aWR0aCA9IDEvMTApICsgDQogIGZhY2V0X2dyaWQoZmFjZXRzPXZhcmlhYmxlIH4gLiwgc2NhbGVzPSJmcmVlX3kiKSArIA0KICB4bGltKDAsMSkgKw0KICB5bGFiKCJDb3VudCBvZiBwLXZhbHVlcyIpICsNCiAgeGxhYigicC12YWx1ZXMiKSArDQogIHRoZW1lKHRleHQgPSBlbGVtZW50X3RleHQoc2l6ZSA9IDE2KSkNCmBgYA0KDQpgYGB7cn0NCg0KbXkuZGF0YSA8LSBybm9ybShuLnJhbmQpDQpteS5kYXRhLjIgPC0gcnQobi5yYW5kLCBkZiA9IDIwKQ0KIyBUcmltIG9mZiB0aGUgdGFpbHMNCm15LmRhdGEgPC0gbXkuZGF0YVt3aGljaChteS5kYXRhIDwgMyAmIG15LmRhdGEgPiAtMyldDQojIEFkZCBpbiB0YWlscyBmcm9tIHRoZSBvdGhlciBkaXN0cmlidXRpb24NCm15LmRhdGEgPC0gYyhteS5kYXRhLCBteS5kYXRhLjJbd2hpY2gobXkuZGF0YS4yIDwgLTMgfCBteS5kYXRhLjIgPiAzKV0pDQpgYGANCg0KYGBge3J9DQpwLmRmLm0gPC0gYXNzaWduX3ZlY3RvcihteS5kYXRhLCBuID0gbi50ZXN0KQ0KZ2dwbG90KHAuZGYubSwgYWVzKHggPSB2YWx1ZSkpICsgDQogIGdlb21faGlzdG9ncmFtKGJpbndpZHRoID0gMS8xMCkgKyANCiAgZmFjZXRfZ3JpZChmYWNldHM9dmFyaWFibGUgfiAuLCBzY2FsZXM9ImZyZWVfeSIpICsgDQogIHhsaW0oMCwxKSArDQogIHlsYWIoIkNvdW50IG9mIHAtdmFsdWVzIikgKw0KICB4bGFiKCJwLXZhbHVlcyIpICsNCiAgdGhlbWUodGV4dCA9IGVsZW1lbnRfdGV4dChzaXplID0gMTYpKQ0KYGBgDQoNCmBgYHtyfQ0KbXkuZGF0YSA8LSBybG5vcm0obi5yYW5kLCAwLCAwLjQpDQpgYGANCg0KYGBge3J9DQpwLmRmLm0gPC0gYXNzaWduX3ZlY3RvcihteS5kYXRhLCBuID0gbi50ZXN0KQ0KZ2dwbG90KHAuZGYubSwgYWVzKHggPSB2YWx1ZSkpICsgDQogIGdlb21faGlzdG9ncmFtKGJpbndpZHRoID0gMS8xMCkgKyANCiAgZmFjZXRfZ3JpZChmYWNldHM9dmFyaWFibGUgfiAuLCBzY2FsZXM9ImZyZWVfeSIpICsgDQogIHhsaW0oLTAuMDUsMS4wNSkgKw0KICB5bGFiKCJDb3VudCBvZiBwLXZhbHVlcyIpICsNCiAgeGxhYigicC12YWx1ZXMiKSArDQogIHRoZW1lKHRleHQgPSBlbGVtZW50X3RleHQoc2l6ZSA9IDE2KSkNCmBgYA0KDQpgYGB7cn0NCmhpc3QobXkuZGF0YSkNCmBgYA0KDQoNCg0KIyMgRGlzY3Vzc2lvbg0KU21hbGwgc2FtcGxlIHNpemVzIHdpbGwgaGF2ZSBhIG5vcm1hbCBkaXN0cmlidXRpb24uIFRoZSBub3JtYWxpdHkgdGVzdHMgYXJlLCBpbmRlZWQsIHZlcnkgc2Vuc2l0aXZlIHRvIHdoYXQgZ29lcyBvbiBpbiB0aGUgZXh0cmVtZSB0YWlscy4=