Вычисление статистики Колмогорова Смирнова для нескольких переменных - PullRequest
Новая
       2

Вычисление статистики Колмогорова Смирнова для нескольких переменных

0 голосов
/ 06 апреля 2019

Я новичок в мире R-кодирования. Я хочу рассчитать статистику KS для нескольких переменных, в результате чего переменные в Excel. Я пытался зациклить вычисления от одной переменной к другой и сохранить результаты KS в кадре данных. У меня нет проблем для расчета статистики KS для одной переменной, например FINALGRADE. Ниже приведены данные с несколькими переменными, например: TMP.

ВОПРОС: Как я могу получить r-коды KS для вычисления из одной переменной в другую переменную и сохранить переменные результаты KS в кадре данных?

Статистика KS - это разница между оценкой неплатежеспособных клиентов и неплатежеспособных клиентов. 

    ID  Default FINALGRADE  FINALSCORE  PREOVERRIDESCORE    SUBJECTIVESCORE FINANCIALSCORE
    10009011    0   8   67.65854557 67.65854557 68.36424313 60.2136826
    10020003    0   7   72.18560889 72.18560889 70.97483009 64.35831722
    10020003    0   6   77.23072833 77.23072833 69.87370952 71.53180821
    10021201    0   14  40.21338437 40.21338437 58.06865599 40.54564338
    10021201    0   8   68.79085151 68.79085151 72.59254723 58.91827403
    10022730    0   4   84.47284986 84.47284986 78.03588557 77.85944161
    10022731    0   5   78.28775535 78.28775535 82.07915713 64.45948626
    10025555    0   15  7.907947702 7.907947702 57.95049201 4.075100629
    10025555    0   13  1.75            47.15981982 72.56744037 39.16338519
    10025763    0   15  66.39063143 66.39063143 79.10054245 52.66288527
    10029315    1   14  40.36515221 40.36515221 57.9586825  40.78027744
    10030999    0   17  25.78498104 25.78498104 84.37428799 16.36896422
    10030999    0   13  47.90043592 47.90043592 78.97405559 36.28646008
    10033303    0   10  58.50724135 58.50724135 74.95635833 47.05689989
    10033938    0   15  32.79988473 37.79988473 45.90931406 43.84648718
    10039393    1   8   67.31395864 67.31395864 74.81030489 55.26979858
    10039780    0   9   64.94318991 69.94318991 69.44595762 62.06825469
    10040777    0   13  44.93908421 44.93908421 81.83346015 32.38398138
    10041213    0   15  33.05768436 33.05768436 73.75578861 27.6882957
    10041213    0   15  35.39463308 35.39463308 73.75578861 28.95912606
    10045566    1   8   70.60067856 70.60067856 70.87753432 61.88535995
    10045566    0   10  58.50956434 58.50956434 70.87753432 49.89960356
    10045692    0   12  50.52222802 50.52222802 50.91083454 52.10279587
    10045692    0   10  59.17371704 59.17371704 57.49697166 57.37504351
    10046390    1   10  60.47796914 60.47796914 67.94551866 52.29460738
    10047830    0   12  51.46066369 51.46066369 79.14482394 39.16019407
    10048824    0   13  50.86887099 50.86887099 65.6366083  46.18752406
    10048824    0   12  49.82958553 49.82958553 60.56566557 47.97788939
    10050504    0   8   67.47839481 67.47839481 72.53163793 58.4371572
    10050504    0   7   73.7608865  73.7608865  69.49809267 67.26984194

# calculate KS
> n_S <- length(tmp$FINALGRADE)

> d <- sum(tmp$Default)

> g <- sum(tmp$Default==0)

> x_S <- NULL

> y_S <- NULL

> z_S <- NULL

>defaultcnt_s <- 0

> goodcnt_s <- 0

> ordereddata <-tmp[order(tmp$FINALGRADE),]

> default <-  ifelse((ordereddata$Default == 0), 0, 1)

> good <- ifelse((ordereddata$Default == 0), 1, 0)

> for (i in 1:n_S)

> {x_S[i] = i/n_S

> defaultcnt_s <- defaultcnt_s + default[i]

> goodcnt_s <- goodcnt_s + good[i]

> y_S[i] <- defaultcnt_s/d

> z_S[i] <- goodcnt_s/g

> }

> K_S <- abs(y_S[which.max(abs(y_S-z_S))]-z_S[which.max(abs(y_S-z_S))])

> ks.test(y_S,z_S,alternative = c('two.sided','less','greater'))

    Variable    FINALGRADE  FINALSCORE  PREOVERRIDESCORE    SUBJECTIVESCORE FINANCIALSCORE  
    KS          …           …           …                   …           …

Ответы [ 3 ]

0 голосов
/ 07 апреля 2019

Вы также можете попробовать: 

results <- outer( 
  1:ncol(df), 1:ncol(df), 
  Vectorize(
    function (i,j) ks.test(df[,i], df[,j], alternative = c('two.sided'))$p.value
  ) 
)
#Because the output is matrix we can convert it to data.frame and set the names of the columns 
results <- as.data.frame(results)
names(results) <- names(df)

Результат: 

                          ID      Default   FINALGRADE
ID               1.000000e+00 1.871836e-13 1.871836e-13
Default          1.871836e-13 1.000000e+00 1.871836e-13
FINALGRADE       1.871836e-13 1.871836e-13 1.000000e+00
FINALSCORE       1.871836e-13 1.871836e-13 8.942624e-12
PREOVERRIDESCORE 1.871836e-13 1.871836e-13 1.337597e-12
SUBJECTIVESCORE  1.871836e-13 1.871836e-13 1.871836e-13
FINANCIALSCORE   1.871836e-13 1.871836e-13 8.942624e-12
                   FINALSCORE PREOVERRIDESCORE SUBJECTIVESCORE
ID               1.871836e-13     1.871836e-13    1.871836e-13
Default          1.871836e-13     1.871836e-13    1.871836e-13
FINALGRADE       8.942624e-12     1.337597e-12    1.871836e-13
FINALSCORE       1.000000e+00     9.999999e-01    1.106169e-03
PREOVERRIDESCORE 9.999999e-01     1.000000e+00    2.908301e-03
SUBJECTIVESCORE  1.106169e-03     2.908301e-03    1.000000e+00
FINANCIALSCORE   1.350035e-01     1.350035e-01    3.239194e-06
                 FINANCIALSCORE
ID                 1.871836e-13
Default            1.871836e-13
FINALGRADE         8.942624e-12
FINALSCORE         1.350035e-01
PREOVERRIDESCORE   1.350035e-01
SUBJECTIVESCORE    3.239194e-06
0 голосов
/ 07 апреля 2019

Действительно ценю ответ от @ r2evans и @ DJV.

Благодарим вас за помощь в решении моей проблемы.

Возможно, я не объяснил свой расчет KS четко. на самом деле, мне требуется рассчитать KS для максимального значения графика / разницы между стандартным (по умолчанию = 1) и хорошим (по умолчанию = 0).

Вот почему у меня есть эта часть кодов, чтобы увидеть хороший и стандартный дистрибутив. Поэтому в основном я вычисляю KS, чтобы увидеть разницу между FINALGRADE (по умолчанию = 1) и FINALGRADE (по умолчанию = 0).

y_S [i] <- defaultcnt_s / d </p>

z_S [i] <- goodcnt_s / g </p>

K_S <- abs (y_S [which.max (abs (y_S-z_S))] - z_S [which.max (abs (y_S-z_S))])) </p>

Прилагается теоретическая и простая иллюстрация FINALGRADE KS, которая представляет собой максимальную разницу между хорошим и плохим:

FINALGRADE KS - максимальная разница между хорошим и плохим

0 голосов
/ 07 апреля 2019

Вот один из способов в базе R. (Данные в конце.)

Вы хотите проводить парные сравнения / тесты.Функция expand.grid даст вам каждую попарную комбинацию с двумя или более векторами.(Он работает с одним вектором, но это не так интересно.) 

cn <- colnames(x)[-(1:2)] # don't need ID, Default
eg <- expand.grid(x=cn, y=cn, stringsAsFactors = FALSE)
nrow(eg)
# [1] 25
head(eg)
#                  x          y
# 1       FINALGRADE FINALGRADE
# 2       FINALSCORE FINALGRADE
# 3 PREOVERRIDESCORE FINALGRADE
# 4  SUBJECTIVESCORE FINALGRADE
# 5   FINANCIALSCORE FINALGRADE
# 6       FINALGRADE FINALSCORE

Мы можем убрать проверку "столбец 1 против 1".Мы также можем уменьшить тестирование «1 против 2» и «2 против 1» (те же результаты), поэтому мы удалим и эти дубликаты (сортируя по строкам и удаляя дубликаты). 

eg <- eg[ eg$x != eg$y, ]
eg$x1 <- ifelse(eg$x < eg$y, eg$x, eg$y)
eg$y <- ifelse(eg$x < eg$y, eg$y, eg$x)
eg$x <- eg$x1
eg$x1 <- NULL # remove the added column
eg <- eg[ !duplicated(eg), ]
head(eg)
#            x                y
# 2 FINALGRADE       FINALSCORE
# 3 FINALGRADE PREOVERRIDESCORE
# 4 FINALGRADE  SUBJECTIVESCORE
# 5 FINALGRADE   FINANCIALSCORE
# 8 FINALSCORE PREOVERRIDESCORE
# 9 FINALSCORE  SUBJECTIVESCORE
nrow(eg)
# [1] 10

Теперь мы можем выполнять тесты. 

results <- Map(function(i1, i2) ks.test(x[,i1], x[,i2]),
               eg$x, eg$y)
# Warning in ks.test(x[, i1], x[, i2]) :
#   cannot compute exact p-value with ties
### repeated total of eight times ... it's a problem with the data

results[[1]]
#   Two-sample Kolmogorov-Smirnov test
# data:  x[, i1] and x[, i2]
# D = 0.93333, p-value = 8.943e-12
# alternative hypothesis: two-sided

Теперь у нас есть все 10 тестов в одном именованном списке.К сожалению, имена не совсем полезны, поскольку в настоящее время они включают только первую переменную, а не обе. 

names(results)
#  [1] "FINALGRADE"       "FINALGRADE"       "FINALGRADE"       "FINALGRADE"      
#  [5] "FINALSCORE"       "FINALSCORE"       "FINALSCORE"       "PREOVERRIDESCORE"
#  [9] "FINANCIALSCORE"   "FINANCIALSCORE"

Это достаточно легко исправить. 

names(results) <- paste(eg$x, eg$y, sep = "_")
str(results[1:2])
# List of 2
#  $ FINALGRADE_FINALSCORE      :List of 5
#   ..$ statistic  : Named num 0.933
#   .. ..- attr(*, "names")= chr "D"
#   ..$ p.value    : num 8.94e-12
#   ..$ alternative: chr "two-sided"
#   ..$ method     : chr "Two-sample Kolmogorov-Smirnov test"
#   ..$ data.name  : chr "x[, i1] and x[, i2]"
#   ..- attr(*, "class")= chr "htest"
#  $ FINALGRADE_PREOVERRIDESCORE:List of 5
#   ..$ statistic  : Named num 0.967
#   .. ..- attr(*, "names")= chr "D"
#   ..$ p.value    : num 1.34e-12
#   ..$ alternative: chr "two-sided"
#   ..$ method     : chr "Two-sample Kolmogorov-Smirnov test"
#   ..$ data.name  : chr "x[, i1] and x[, i2]"
#   ..- attr(*, "class")= chr "htest"

Возможно, вы захотите просто p.value (или еще одна статистика) из каждого теста.Это может быть легко выполнено с помощью lapply (возвращает list) или sapply (часто возвращает вектор): 

sapply(results, `[[`, "p.value")
#            FINALGRADE_FINALSCORE      FINALGRADE_PREOVERRIDESCORE 
#                     8.942624e-12                     1.337597e-12 
#       FINALGRADE_SUBJECTIVESCORE        FINALGRADE_FINANCIALSCORE 
#                     1.871836e-13                     8.942624e-12 
#      FINALSCORE_PREOVERRIDESCORE       FINALSCORE_SUBJECTIVESCORE 
#                     9.999999e-01                     1.106169e-03 
#        FINALSCORE_FINANCIALSCORE PREOVERRIDESCORE_SUBJECTIVESCORE 
#                     1.350035e-01                     2.908301e-03 
#  FINANCIALSCORE_PREOVERRIDESCORE   FINANCIALSCORE_SUBJECTIVESCORE 
#                     1.350035e-01                     3.239194e-06

Или, вместо того, чтобы иметь дело с отдельными векторами и т.п., вы можете добавитьэто в eg фрейм: 

head(eg)
#            x                y      p.value
# 2 FINALGRADE       FINALSCORE 8.942624e-12
# 3 FINALGRADE PREOVERRIDESCORE 1.337597e-12
# 4 FINALGRADE  SUBJECTIVESCORE 1.871836e-13
# 5 FINALGRADE   FINANCIALSCORE 8.942624e-12
# 8 FINALSCORE PREOVERRIDESCORE 9.999999e-01
# 9 FINALSCORE  SUBJECTIVESCORE 1.106169e-03

Если вы хотите все из них, вы можете легко сделать это тоже: 

cbind(eg, sapply(c("statistic", "p.value", "alternative"),
                 function(nm) sapply(results, `[[`, nm),
                 simplify = FALSE),
      stringsAsFactors = FALSE)
#                   x                y      p.value  statistic      p.value alternative
# 2        FINALGRADE       FINALSCORE 8.942624e-12 0.93333333 8.942624e-12   two-sided
# 3        FINALGRADE PREOVERRIDESCORE 1.337597e-12 0.96666667 1.337597e-12   two-sided
# 4        FINALGRADE  SUBJECTIVESCORE 1.871836e-13 1.00000000 1.871836e-13   two-sided
# 5        FINALGRADE   FINANCIALSCORE 8.942624e-12 0.93333333 8.942624e-12   two-sided
# 8        FINALSCORE PREOVERRIDESCORE 9.999999e-01 0.06666667 9.999999e-01   two-sided
# 9        FINALSCORE  SUBJECTIVESCORE 1.106169e-03 0.50000000 1.106169e-03   two-sided
# 10       FINALSCORE   FINANCIALSCORE 1.350035e-01 0.30000000 1.350035e-01   two-sided
# 14 PREOVERRIDESCORE  SUBJECTIVESCORE 2.908301e-03 0.46666667 2.908301e-03   two-sided
# 15   FINANCIALSCORE PREOVERRIDESCORE 1.350035e-01 0.30000000 1.350035e-01   two-sided
# 20   FINANCIALSCORE  SUBJECTIVESCORE 3.239194e-06 0.66666667 3.239194e-06   two-sided

Данные: 

x <- read.table(header=TRUE, text='
ID  Default FINALGRADE  FINALSCORE  PREOVERRIDESCORE    SUBJECTIVESCORE FINANCIALSCORE
10009011    0   8   67.65854557 67.65854557 68.36424313 60.2136826
10020003    0   7   72.18560889 72.18560889 70.97483009 64.35831722
10020003    0   6   77.23072833 77.23072833 69.87370952 71.53180821
10021201    0   14  40.21338437 40.21338437 58.06865599 40.54564338
10021201    0   8   68.79085151 68.79085151 72.59254723 58.91827403
10022730    0   4   84.47284986 84.47284986 78.03588557 77.85944161
10022731    0   5   78.28775535 78.28775535 82.07915713 64.45948626
10025555    0   15  7.907947702 7.907947702 57.95049201 4.075100629
10025555    0   13  1.75            47.15981982 72.56744037 39.16338519
10025763    0   15  66.39063143 66.39063143 79.10054245 52.66288527
10029315    1   14  40.36515221 40.36515221 57.9586825  40.78027744
10030999    0   17  25.78498104 25.78498104 84.37428799 16.36896422
10030999    0   13  47.90043592 47.90043592 78.97405559 36.28646008
10033303    0   10  58.50724135 58.50724135 74.95635833 47.05689989
10033938    0   15  32.79988473 37.79988473 45.90931406 43.84648718
10039393    1   8   67.31395864 67.31395864 74.81030489 55.26979858
10039780    0   9   64.94318991 69.94318991 69.44595762 62.06825469
10040777    0   13  44.93908421 44.93908421 81.83346015 32.38398138
10041213    0   15  33.05768436 33.05768436 73.75578861 27.6882957
10041213    0   15  35.39463308 35.39463308 73.75578861 28.95912606
10045566    1   8   70.60067856 70.60067856 70.87753432 61.88535995
10045566    0   10  58.50956434 58.50956434 70.87753432 49.89960356
10045692    0   12  50.52222802 50.52222802 50.91083454 52.10279587
10045692    0   10  59.17371704 59.17371704 57.49697166 57.37504351
10046390    1   10  60.47796914 60.47796914 67.94551866 52.29460738
10047830    0   12  51.46066369 51.46066369 79.14482394 39.16019407
10048824    0   13  50.86887099 50.86887099 65.6366083  46.18752406
10048824    0   12  49.82958553 49.82958553 60.56566557 47.97788939
10050504    0   8   67.47839481 67.47839481 72.53163793 58.4371572
10050504    0   7   73.7608865  73.7608865  69.49809267 67.26984194')
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...