Add within-collection comparisons.

R/01-within.R

@@ -0,0 +1,116 @@
+source("R/common.R")
+source("R/std.R")
+
+library(ircor)
+library(rio)
+library(doParallel)
+stopImplicitCluster()
+registerDoParallel(cores = .CORES)
+
+#' compute statistics between raw scores x and standardized scores y
+within_collection <- function(x, y) {
+  n_s <- ncol(x) # number of systems
+  means_x <- colMeans(x)
+  means_y <- colMeans(y)
+
+  # correlations (b for ties)
+  tau <- tau_b(means_x, means_y)
+  tauAP <- tauAP_b(means_x, means_y)
+  r <- cor(means_x, means_y, method = "pearson")
+
+  # paired t-test between every pair of systems
+  power <- unlist(sapply(1:(n_s-1), function(i) {
+    sapply((i+1):n_s, function(j) {
+      t.test(y[,i], y[,j], paired = TRUE)$p.value
+    })
+  }))
+  power <- ecdf(power)(.ALPHAS)
+
+  list(tau = unname(tau), tauAP = unname(tauAP), r = unname(r),
+       power = unname(power))
+}
+
+# Compute ------------------------------------------------------------------------------------------
+
+path_out <- "scratch/01-within"
+
+for(batch in 1:.BATCHES) {
+  for(collection in .COLLECTIONS) {
+    for(measure in .MEASURES) {
+      collmea <- paste0(collection, "_", measure)
+      path_out_collmea <- file.path(path_out, collmea)
+
+      x <- import(file.path("data", paste0(collmea, ".csv")))
+      n_t <- nrow(x)
+      n <- 50
+
+      for(std in stds) {
+        path_out_collmea_std <- file.path(path_out_collmea, std$name)
+        dir.create(path_out_collmea_std, recursive = TRUE)
+        cat(path_out_collmea_std, "\n")
+
+        # Compute std factors
+        std_f <- std$factors(x)
+        y <- std$standardize(std_f, x)
+
+        res <- foreach(trial = 1:.TRIALS, .packages = "ircor", .combine = function(a,b) {
+          l <- list()
+          for(name in names(a)){
+            l[[name]] <- rbind(a[[name]], b[[name]])
+          }
+          l
+        }) %dopar% {
+          set.seed(batch*.TRIALS + trial)
+          # sample a subset of n topics
+          i <- sample(1:n_t, n)
+          x_trial <- x[i,]
+          y_trial <- y[i,]
+
+          within_collection(x_trial, y_trial)
+        }
+
+        for(name in names(res))
+          export(round(res[[name]], .SIGNIF), file.path(path_out_collmea_std, paste0(name, ".csv")),
+                 append = TRUE)
+      }
+    }
+  }
+}
+
+stopImplicitCluster()
+
+# Reduce -------------------------------------------------------------------------------------------
+
+path_in <- path_out
+path_out <- "out/01-within"
+
+for(collection in .COLLECTIONS) {
+  for(measure in .MEASURES) {
+    collmea <- paste0(collection, "_", measure)
+    path_in_collmea <- file.path(path_in, collmea)
+    path_out_collmea <- file.path(path_out, collmea)
+    dir.create(path_out_collmea, recursive = TRUE)
+
+    r <- sapply(stds, function(std) {
+      import(file.path(path_in_collmea, std$name, "tau.csv"))[,1]
+    })
+    export(r, file.path(path_out_collmea, "tau.csv"))
+
+    r <- sapply(stds, function(std) {
+      import(file.path(path_in_collmea, std$name, "tauAP.csv"))[,1]
+    })
+    export(r, file.path(path_out_collmea, "tauAP.csv"))
+
+    r <- sapply(stds, function(std) {
+      import(file.path(path_in_collmea, std$name, "r.csv"))[,1]
+    })
+    export(r, file.path(path_out_collmea, "r.csv"))
+
+    r <- sapply(stds, function(std) {
+      r <- import(file.path(path_in_collmea, std$name, "power.csv"))
+      colMeans(r)
+    })
+    r <- cbind(alpha = .ALPHAS, r)
+    export(r, file.path(path_out_collmea, "power.csv"))
+  }
+}

out/01-within/robust2004_ap/power.csv

@@ -0,0 +1,20 @@
+alpha,raw,N-std,U-std,z-std,E-std
+0.001,0.4076267246,0.4271565422,0.4164595194,0.4128708013,0.4259163777
+0.002,0.440674702,0.4572680397,0.4465686444,0.4428586871,0.4557297698
+0.003,0.4614130849,0.476269768,0.4656625051,0.4619039017,0.4745024628
+0.004,0.4768426333,0.4904280085,0.4799155803,0.4761345665,0.488451958
+0.005,0.4892171089,0.5018111592,0.4914249997,0.487642253,0.4996620058
+0.006,0.4996203918,0.5114047967,0.5010817383,0.4972972993,0.5090964965
+0.007,0.5086080092,0.5197364142,0.5095078832,0.5057261044,0.5172550386
+0.008,0.516564764,0.5271085927,0.5169603712,0.5131897448,0.5244880962
+0.009,0.523718722,0.5337338935,0.5236851692,0.5199193992,0.5310041002
+0.01,0.530233723,0.5397540976,0.5297924329,0.5260352567,0.5369116756
+0.02,0.5756184949,0.5819239145,0.5727166579,0.569040203,0.5783362633
+0.03,0.6043636991,0.6088834702,0.6002151996,0.5966104548,0.6048788309
+0.04,0.6258789705,0.6291925358,0.6209149647,0.6173886841,0.6249029009
+0.05,0.6432312666,0.6456655206,0.6377295608,0.6342844945,0.6412123671
+0.06,0.6578673699,0.6596336255,0.6519818812,0.6486326455,0.6550441075
+0.07,0.6705753557,0.6718692824,0.6644080973,0.6611587214,0.6671695756
+0.08,0.6818632458,0.682749294,0.6754783472,0.6723249395,0.6780182065
+0.09,0.6920594554,0.6926009042,0.6854917904,0.6824540712,0.6878800358
+0.1,0.7013589818,0.7016200104,0.6946820372,0.6917442458,0.6969132749