Как я могу создать функцию для моего определенного расчета?

Question

У меня есть определенный расчет, как показано в r-кодах ниже.

Это то, что я пробовал, вычисляя результат на основе одной переменной, то есть FINALGRADE.

Как я могу создать функцию из этого вычисления, чтобы я мог генерировать результат для таких переменных, как FINALSCORE, PREOVERRIDESCORE, SUBJECTIVESCORE и FINANCIALSCORE?

tmp $ Значение по умолчанию исправлено, мне просто нужно изменить FINALGRADE, чтобы стать FINALSCORE и так далее.

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))])

Это мои данные:

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

Answer 1

result <- function(data, var) {
n_S <- length(data[[var]])
d <- sum(data$Default)
g <- sum(data$Default==0)

x_S <- NULL
y_S <- NULL
z_S <- NULL

defaultcnt_s <- 0
goodcnt_s <- 0
ordereddata <-tmp[order(tmp[[var]]),]
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))])
return(K_S)
}

print(result(tmp, "FINALGRADE"))
# 0.2884615

print(result(tmp, "FINALSCORE"))
# 0.3653846

vars <- c('FINALGRADE', 'FINALSCORE', 'PREOVERRIDESCORE', 'SUBJECTIVESCORE', 'FINANCIALSCORE')
data.frame(Result = sapply(vars, function(x) result(tmp, x)))

#                     Result
# FINALGRADE       0.2884615
# FINALSCORE       0.3653846
# PREOVERRIDESCORE 0.3653846
# SUBJECTIVESCORE  0.3269231
# FINANCIALSCORE   0.3461538