analyze_quality_models_unweighted.R

   1 library(MASS)
   2 library(brms)
   3 options(mc.cores=28)
   4 library(ggplot2)
   5 library(data.table)
   6 library(arrow)
   7 library(wCorr)
   8
   9 source("RemembR/R/RemembeR.R")
  10
  11 change.remember.file("ordinal.quality.analysis.noweights.RDS")
  12
  13 #model.1 <- readRDS("models/ordinal_quality_intercept.RDS")
  14 model.main.pca <- readRDS("models/ordinal_quality_pca.noweights.RDS")
  15 model.main.pca.cumulative <- readRDS("models/ordinal_quality_pca.noweights.cumulative.RDS")
  16 model.qe6 <- readRDS("models/ordinal_quality_qe6.noweights.RDS")
  17 df <- readRDS("data/training_quality_labels.RDS")
  18
  19 # then compare them with loo
  20 comparison.loo <- loo_compare(model.main.pca,model.qe6,model.main.pca.cumulative)
  21 #comparison.waic <- loo_compare(model.main.noC,model.main.noB,model.main.noFa,model.main.noGa,model.main.noStart,model.main.noStub,criterion='waic')
  22 print(comparison.loo,simplify=F,digits=2)
  23 remember(comparison.loo,"comparison.loo")
  24
  25 # LOO Chooses NoC
  26 best.model <- model.main.pca.cumulative
  27
  28 pca_features_unweighted <- readRDS("data/ores_pca_features.noweights.RDS")
  29
  30 test.df <- readRDS("data/holdout_quality_labels.RDS")
  31
  32 wpca_transform <- function(wpca, x){
  33     x <- as.matrix(x)
  34     centered <- as.matrix(t(t(x) - wpca$means))
  35     return(centered %*% wpca$basis)
  36 }
  37
  38 unweighted.pca <- wpca_transform(pca_features_unweighted, test.df[,.(Stub, Start, C, B, GA, FA)])
  39
  40 test.df <- test.df[,":="(pca1.noweights = unweighted.pca[,1],
  41                          pca2.noweights = unweighted.pca[,2],
  42                          pca3.noweights = unweighted.pca[,3],
  43                          pca4.noweights = unweighted.pca[,4],
  44                          pca5.noweights = unweighted.pca[,5],
  45                          pca6.noweights = unweighted.pca[,6])]
  46
  47 draws <- as.data.table(best.model)
  48
  49 test.df <- test.df[,idx.max:=.(apply(test.df[,.(Stub,Start,C,B,GA,FA)],1,which.max))]
  50 test.df <- test.df[,MPQC:=.(apply(test.df[,.(idx.max)],1,function(idx) c("stub","start","c","b","ga","fa")[idx]))]
  51 top.preds <- test.df[,MPQC]
  52
  53 #ordinal.fitted.1 <- fitted(best.model, test.df, scale='response')
  54 ordinal.fitted <- data.table(fitted(best.model, test.df, scale='linear'))
  55 ordinal.pred <- ordinal.fitted$Estimate
  56 remember(ordinal.fitted,'ordinal.fitted')
  57
  58 quality.ordinal <- ordinal.pred
  59 quality.even6 <- apply(test.df[,.(Stub,Start,B,C,GA,FA)],1,function(r) r %*% c(0,1,2,3,4,5))
  60 quality.even5 <- apply(test.df[,.(Stub,Start,B,GA,FA)],1,function(r) r %*% c(1,2,3,4,5))
  61
  62 test.df <- test.df[,quality.ordinal := quality.ordinal]
  63 test.df <- test.df[,quality.even6 := quality.even6]
  64
  65 (spearcor <- cor(test.df$quality.ordinal, test.df$quality.even6, method='spearman'))
  66 remember(spearcor, 'spearman.corr')
  67 (pearsoncor <- cor(test.df$quality.ordinal, test.df$quality.even6, method='pearson'))
  68 remember(pearsoncor, 'pearson.corr')
  69
  70 ordinal.preds <- data.table(predict(best.model, test.df, robust=T))
  71 #names(ordinal.preds) <- c("Stub","Start","C","B","A","GA","FA")
  72 names(ordinal.preds) <- c("Stub","Start","C","B","GA","FA")
  73 ordinal.preds <- ordinal.preds[,idx.max:=.(apply(ordinal.preds[,.(Stub,Start,C,B,GA,FA)],1,which.max))]
  74 #ordinal.preds <- ordinal.preds[,predicted:=.(apply(ordinal.preds[,.(idx.max)],1,function(idx) c("stub","start","c","b",'a',"ga","fa")[idx]))]
  75 ordinal.preds <- ordinal.preds[,predicted:=.(apply(ordinal.preds[,.(idx.max)],1,function(idx) c("stub","start","c","b","ga","fa")[idx]))]
  76 pred.qe6 <- data.table(predict(model.qe6,test.df))
  77 names(pred.qe6) <- c("Stub","Start","C","B","GA","FA")
  78 pred.qe6 <- pred.qe6[,idx.max:=.(apply(pred.qe6[,.(Stub,Start,C,B,GA,FA)],1,which.max))]
  79 #pred.qe6 <- pred.qe6[,predicted:=.(apply(pred.qe6[,.(idx.max)],1,function(idx) c("stub","start","c","b",'a',"ga","fa")[idx]))]
  80 pred.qe6 <- pred.qe6[,predicted:=.(apply(pred.qe6[,.(idx.max)],1,function(idx) c("stub","start","c","b","ga","fa")[idx]))]
  81
  82 test.df <- test.df[,ordinal.pred := ordinal.preds$predicted]
  83 test.df <- test.df[,pred.qe6 := pred.qe6$predicted]
  84 test.df <- test.df[,idx.max:=.(apply(test.df[,.(Stub,Start,C,B,GA,FA)],1,which.max))]
  85 test.df <- test.df[,MPQC:=.(apply(test.df[,.(idx.max)],1,function(idx) c("stub","start","c","b","ga","fa")[idx]))]
  86
  87 (top.pred.accuracy <- test.df[,mean(MPQC==wp10)])
  88 remember(top.pred.accuracy, "top.pred.accuracy")
  89 (ordinal.pred.accuracy <- test.df[,mean(ordinal.pred == wp10)])
  90 remember(ordinal.pred.accuracy, "ordinal.pred.accuracy")
  91 quality.even6 <- apply(df[,.(Stub,Start,B,C,GA,FA)],1,function(r) r %*% c(1,2,3,4,5,6))
  92 (pred.qe6.accuracy <- mean(test.df[,.(pred.qe6)] == test.df[,.(wp10)]))
  93 remember(ordinal.pred.accuracy, "ordinal.pred.accuracy")
  94 remember(best.model, "best.model")
  95
  96 (accuracy.macro <- test.df[,.(top.pred.accuracy = mean(MPQC==wp10),
  97                               ordinal.pred.accuracy = mean(ordinal.pred==wp10),
  98                               pred.qe6.accuracy = mean(pred.qe6==wp10)),by=.(wp10)])
  99
 100 accuracy.macro[,sapply(.SD,mean), .SDcols=c("top.pred.accuracy","ordinal.pred.accuracy","pred.qe6.accuracy")]
 101
 102
 103 remember(test.df,'test.df')
 104
 105
 106 ordinal.preds[,wp10:=test.df$wp10]
 107 ordinal.preds[,weight:=test.df$article_weight]
 108 total.weight <- sum(ordinal.preds$weight)
 109 library(modi)
 110 calibration.stats.1 <- ordinal.preds[,.(prob.predicted=apply(.SD,2,function(c) weighted.mean(c,weight)),
 111                                       var.predicted=apply(.SD,2,function(c) weighted.var(c,weight))),.SDcols=c("Stub","Start","C","B","GA","FA")]
 112
 113 calibration.stats.1[,wp10:=c("stub","start","c","b","ga","fa")]
 114 calip.data = ordinal.preds[order(wp10),.(prob.data=sum(weight)/total.weight,
 115                                          var.data=var(weight)/total.weight),by=.(wp10)]
 116
 117 calibration.stats.1 <- calibration.stats.1[calip.data,on=.(wp10)]
 118
 119 calibration.stats.1$weighttype <- 'Article weight'
 120
 121 ordinal.preds[,weight:=test.df$revision_weight]
 122 total.weight <- sum(ordinal.preds$weight)
 123
 124 calibration.stats.2 <- ordinal.preds[,.(prob.predicted=apply(.SD,2,function(c) weighted.mean(c,weight)),
 125                                         var.predicted=apply(.SD,2,function(c) weighted.var(c,weight))),.SDcols=c("Stub","Start","C","B","GA","FA")]
 126
 127
 128 calibration.stats.2[,wp10:=c("stub","start","c","b","ga","fa")]
 129 calip.data = ordinal.preds[order(wp10),.(prob.data=sum(weight)/total.weight,
 130                                          var.data=var(weight)/total.weight),by=.(wp10)]
 131
 132 calibration.stats.2 <- calibration.stats.2[calip.data,on=.(wp10)]
 133
 134 calibration.stats.2$weighttype <- 'Revision weight'
 135
 136
 137 ordinal.preds[,weight:=rep(1,nrow(ordinal.preds))]
 138 total.weight <- sum(ordinal.preds$weight)
 139
 140 calibration.stats.3 <- ordinal.preds[,.(prob.predicted=apply(.SD,2,function(c) weighted.mean(c,weight)),
 141                                         var.predicted=apply(.SD,2,function(c) weighted.var(c,weight))),.SDcols=c("Stub","Start","C","B","GA","FA")]
 142
 143
 144 calibration.stats.3[,wp10:=c("stub","start","c","b","ga","fa")]
 145 calip.data = ordinal.preds[order(wp10),.(prob.data=sum(weight)/total.weight,
 146                                          var.data=var(weight)/total.weight),by=.(wp10)]
 147
 148 calibration.stats.3 <- calibration.stats.3[calip.data,on=.(wp10)]
 149
 150 calibration.stats.3$weighttype <- 'No weight'
 151
 152 calibration.stats <- rbind(calibration.stats.1,calibration.stats.2,calibration.stats.3)
 153
 154 calibration.stats[,'calibration':=prob.data - prob.predicted]
 155
 156 remember(calibration.stats, "calibration.stats")
 157
 158 ## p <- ggplot(data.frame(quality.ordinal, quality.even6, quality.even5))
 159 ## p <- p + geom_point(aes(x=quality.even6,y=quality.ordinal)) + geom_smooth(aes(x=quality.even6,y=quality.ordinal))
 160
 161 ## print(p)
 162 ## dev.off()
 163
 164 ## post.pred <- posterior_predict(model.main)
 165 ## preds <- as.character(predict(polrmodel))
 166 ## polrmodel.accuracy <- weighted.mean(preds==df$wp10,df$weight)