Summary

Имеется набор данных “German Credit” — обезличенная информация о людях, бравших кредит в банке и вернувших, либо не вернувших его.

Была разработана функция проверки стабильности популяции: такая функция предназначена для того, чтобы отслеживать, есть ли в текущем потоке кредитных заявок существенные отличия от “базовой” популяции.

Решение задачи

Будем проверять для каждого параметра гипотезу, что значения этого параметра в текущем потоке и “базовой” популяции принадлежат к одному распределению. Делать это будем с помощью перестановочного теста (permutation test), в качестве метода вычисления p-значений будем использовать метод Монте-Карло. Коррекцию на множественное тестирование будем осуществлять методом Бенджамини-Хохберга. Функция popChange, код которой приведен ниже, принимает на вход “старую” и “новую” популяции, а возвращает список p-значений для всех параметров с учетом корректировки Бенджамини-Хохберга, минимальное скорректированное p-значение по всем параметрам и список параметров, скорректированные p-значения которых меньше порогового \(0.05\).

library(perm)
popChange<-function(oldpop, newpop){
  #тестируем каждый параметр с помощью permutation test
  pval<-sapply(2:21, function(x) 
                   permTS(as.numeric(oldpop[,x]), y = as.numeric(newpop[,x]), method = "exact.mc")$p.value)
  #корректировка Бенджамини-Хохберга
  #запоминаем порядок, в котором возрастают p-значения
  asc<-order(pval)
  #сортируем и домножаем на веса.
  pval<-pval[asc]*length(pval)/(1:length(pval))
  #возвращаем правильный порядок параметров
  pval[asc]<-pval
  #формируем список возвращаемых значений
  results<-list(pvals = pval, minpval = min(pval), which = colnames(oldpop[2:21])[which(pval<=.05)])
  return(results)
}

Проведем несколько экспериментов.

Случайная выборка

Случайным образом разделим пополам нашу популяцию на “старую” и “новую”. Две популяции, полученные таким образом, не должны различаться.

setwd('~/R/DoubleData/')
german<-read.csv("germancredit.csv")
old<-sample(nrow(german), nrow(german)/2)
popChange(german[old,],german[-old,])
## $pvals
##  [1] 1.0282353 0.4800000 0.9726316 0.5200000 1.0613333 0.6600000 0.4900000
##  [8] 1.1200000 0.8520000 0.9755556 0.8844444 0.7266667 0.9200000 0.9975000
## [15] 0.8181818 0.9833333 0.9840000 0.9938462 0.9000000 0.6400000
## 
## $minpval
## [1] 0.48
## 
## $which
## character(0)

Наш отчет не нашел существенных различий между двумя популяциями, что подтверждает исходную гипотезу.

Разбиение по бинарному фактору

Переменная tele в нашем наборе данных принимает только два значения: A191 и A192. Разобьем популяцию по этому признаку и запустим проверку. Она как минимум должна сказать, что по переменной tele распределения будут разные.

library(dplyr)
oldgerman<-filter(german, tele == "A191")
newgerman<-filter(german, tele == "A192")
popChange(oldgerman, newgerman)
## $pvals
##  [1] 0.054545455 0.040000000 0.144000000 0.588888889 0.020000000
##  [6] 0.016000000 0.094285714 0.690526316 0.520000000 0.053333333
## [11] 0.013333333 0.010000000 0.008000000 0.602352941 0.013333333
## [16] 0.061538462 0.006666667 0.658000000 0.005714286 0.005000000
## 
## $minpval
## [1] 0.005
## 
## $which
##  [1] "duration"  "amount"    "savings"   "residence" "property" 
##  [6] "age"       "housing"   "job"       "tele"      "foreign"

Возвращаемые значения показывают, что две популяции существенно отличаются, в том числе по параметру tele.

Заключение

Разработана функция popChange, осуществляющая проверку стабильности популяции. Функция принимает на вход “базовую” популяцию и текущий поток и возвращает список параметров, по которым состав популяции значимо изменился. В качестве сигнала о том, что состав популяции изменился, может использоваться проверка popChange$minpval < 0.05.