add_quality_scores.R

   1 #!/usr/bin/env Rscript
   2 library(arrow)
   3 library(brms)
   4 library(data.table)
   5 library(ggplot2)
   6 library(parallel)
   7 options(mc.cores=26)
   8 registerDoParallel(cores=26)
   9
  10 dataset <- as.data.table(read_feather("data/scored_article_sample.feather"))
  11 dataset <- dataset[order(articleid,time_session_end)]
  12 quality_model <- readRDS("models/ordinal_quality_noFa.RDS")
  13 posterior_coefs <- as.data.table(quality_model)
  14
  15 f <- function(cols){
  16     post_qual <- as.matrix(posterior_coefs[,.(b_Stub, b_Start, b_C, b_B, b_GA)]) %*% as.numeric(cols)
  17     list(med_quality = median(post_qual),
  18          mean_quality = mean(post_qual),
  19          sd_quality = sd(post_qual)
  20          )
  21
  22 }
  23
  24 cl <- makeForkCluster(nnodes=26)
  25 res <- rbindlist(parApply(cl,dataset[,.(Stub,Start,C,B,GA)],1,f))
  26 dataset[,names(res):=res]
  27
  28 f2 <- function(revscores){
  29     posterior_quality <- as.matrix(posterior_coefs[,.(b_Stub,b_Start,b_C,b_B,b_GA)]) %*% t(as.matrix(revscores))
  30     posterior_quality_diff <- apply(posterior_quality, 1, function(x) diff(x,1,1))
  31     posterior_quality_diff2 <- apply(posterior_quality, 1, function(x) diff(x,1,2))
  32     list(
  33          mean_quality_diff1 = c(NA,apply(posterior_quality_diff,1,mean)),
  34          sd_quality_diff1 = c(NA,apply(posterior_quality_diff,1,sd)),
  35          median_quality_diff1 = c(NA,apply(posterior_quality_diff,1,median)),
  36          mean_quality_diff2 = c(c(NA,NA),apply(posterior_quality_diff2,1,mean)),
  37          sd_quality_diff2 = c(c(NA,NA),apply(posterior_quality_diff2,1,sd)),
  38          median_quality_diff2 = c(c(NA,NA),apply(posterior_quality_diff2,1,median)))
  39 }
  40
  41
  42 dataset[,c("mean_qual_diff1","sd_qual_diff1","median_qual_diff1","mean_qual_diff2","sd_qual_diff2","median_qual_diff2"):=f2(.SD),by=.(articleid),.SDcols=c("Stub","Start","C","B","GA")]
  43
  44 write_feather(dataset,'data/ordinal_scored_article_sample.feather')
  45
  46 ## in an earlier version I computed the full posterior of quality for the dataset, but it took too much memory.
  47 ## Lines below checked (and confirmed) that posteriors were approximately normal.
  48 ## we can check that the means and the medians are close as a clue that normality is a good assumptoin
  49 ## mean(med_quality/mean_quality)
  50 ## mean(med_quality - mean_quality)
  51 ## mean((med_quality - mean_quality)^2)
  52
  53 ## ## plot some of the posteriors to check.
  54 ## quality_post <- dataset[1:8]
  55 ## quality_post <- melt(quality_post)
  56 ## p <- ggplot(quality_post, aes(x=value,group=variable)) + geom_histogram(bins=50) + facet_wrap(.~variable)
  57 ## ggsave("plots/quality_posterior_normality.pdf",device='pdf')
  58
  59