分類モデルと同様のスコアのランダム生成

こんにちは仲間の数クラッカー

バイナリ分類モデルによって生成されたかのように、（クラスラベルと共に）n個のランダムスコアを生成したいと思います。詳細には、次のプロパティが必要です。

• すべてのスコアは0から1の間です
• すべてのスコアは、値が「0」または「1」のバイナリラベルに関連付けられています（後半は陽性クラス）
• スコアの全体的な精度は、たとえば0.1（<-ジェネレータのパラメータ）である必要があります
• ラベル「1」のスコアの比率は、上部セクション全体の精度より高く、下部セクションでは低くする必要があります（<-「モデル品質」もジェネレーターのパラメーターである必要があります）
• スコアは、結果のroc曲線が滑らかになるようにしてください（たとえば、ラベル「1」のスコアの束が上部にあり、ラベル「1」の残りのスコアが下部にあるなどリスト）。

これにどのように取り組むかについて誰かが考えを持っていますか？多分roc-curveの生成を介して、その治療法からポイントを生成しますか？前もって感謝します！

時間が経ちましたが、解決策が見つかるかもしれません。一般的な考え方を説明するために、私のアプローチについて簡単に説明します。コードは、詳細を理解するのに十分でなければなりません。ここにコードを添付するのが好きですが、たくさんあるので、stackexchangeを使用すると簡単には行えません。もちろん、コメントがあれば喜んでお答えします。また、批判にも感謝します。

コードは以下にあります。

戦略：

1. 区間[0,6]でロジスティック関数を使用して、滑らかなROC曲線を近似します。
2. $f_k(x)=\frac{1}{(1+exp(-k*x))}$
3. ここで、目的のAUCに一致するroc曲線がある場合、サンプルごとに[0,1]から均一にスコアを決定します。これは、ROC曲線のfpr（False-Positive-Rate）を表します。簡単にするために、スコアは1-fprとして計算されます。
4. ラベルは、このfprでのROC曲線の傾きとスコアの望ましい全体的な精度を使用して計算されたpを使用したベルヌーイ分布からサンプリングすることによって決定されます。詳しくは、weight（label = "1"）：= lope（fpr）は全体的な精度によって乗算され、weight（label = "0"）：= 1は（1-overallPrecision）で乗算されます。重みを合計して1になるように正規化し、pと1-pを決定します。

AUC = 0.6および全体の精度= 0.1のROC曲線の例を次に示します（以下のコードでも）

ノート：

• 結果のAUCは入力AUCと正確に同じではなく、実際には小さなエラー（約0.02）があります。このエラーは、スコアのラベルが決定される方法に起因します。エラーのサイズを制御するパラメーターを追加することで改善することができます。
• スコアは1-fprとして設定されます。ROC-Curveは、ソートできる限り、スコアがどのように見えるかを気にしないため、これは任意です。

コード：

# This function creates a set of random scores together with a binary label
# n = sampleSize
# basePrecision = ratio of positives in the sample (also called overall Precision on stats.stackexchange)
# auc = Area Under Curve i.e. the quality of the simulated model. Must be in [0.5,1].
# 
binaryModelScores <- function(n,basePrecision=0.1,auc=0.6){
  # determine parameter of logistic function
  k <- calculateK(auc)

  res <- data.frame("score"=rep(-1,n),"label"=rep(-1,n))
  randUniform = runif(n,0,1)
  runIndex <- 1
  for(fpRate in randUniform){
    tpRate <- roc(fpRate,k)

    # slope
    slope <- derivRoc(fpRate,k)

    labSampleWeights <- c((1-basePrecision)*1,basePrecision*slope)
    labSampleWeights <- labSampleWeights/sum(labSampleWeights)

    res[runIndex,1] <- 1-fpRate # score
    res[runIndex,2] <- sample(c(0,1),1,prob=labSampleWeights) # label

    runIndex<-runIndex+1
  }
  res
} 

# min-max-normalization of x (fpr): [0,6] -> [0,1]
transformX <- function(x){
  (x-0)/(6-0) * (1-0)+0
}

# inverse min-max-normalization of x (fpr): [0,1] -> [0,6]
invTransformX <- function(invx){
  (invx-0)/(1-0) *(6-0) + 0
}

#  min-max-normalization of y (tpr): [0.5,logistic(6,k)] -> [0,1]
transformY <- function(y,k){
 (y-0.5)/(logistic(6,k)-0.5)*(1-0)+0
}

# logistic function
logistic <- function(x,k){
  1/(1+exp(-k*x))
}

# integral of logistic function
intLogistic <- function(x,k){
  1/k*log(1+exp(k*x))
}

# derivative of logistic function
derivLogistic <- function(x,k){
  numerator <- k*exp(-k*x)
  denominator <- (1+exp(-k*x))^2
  numerator/denominator
}

# roc-function, mapping fpr to tpr
roc <- function(x,k){
  transformY(logistic(invTransformX(x),k),k)
}

# derivative of the roc-function
derivRoc <- function(x,k){
    scalFactor <- 6 / (logistic(6,k)-0.5)
    derivLogistic(invTransformX(x),k) * scalFactor
}

# calculate the AUC for a given k 
calculateAUC <- function(k){
  ((intLogistic(6,k)-intLogistic(0,k))-(0.5*6))/((logistic(6,k)-0.5)*6)
}

# calculate k for a given auc
calculateK <- function(auc){
  f <- function(k){
      return(calculateAUC(k)-auc)
  }  
  if(f(0.0001) > 0){
     return(0.0001)
  }else{  
    return(uniroot(f,c(0.0001,100))$root)
  }
}

# Example
require(ROCR)

x <- seq(0,1,by=0.01)
k <- calculateK(0.6)
plot(x,roc(x,k),type="l",xlab="fpr",ylab="tpr",main=paste("ROC-Curve for AUC=",0.6," <=> k=",k))

dat <- binaryModelScores(1000,basePrecision=0.1,auc=0.6)

pred <- prediction(dat$score,as.factor(dat$label))
performance(pred,measure="auc")@y.values[[1]]
perf <- performance(pred, measure = "tpr", x.measure = "fpr") 
plot(perf,main="approximated ROC-Curve (random generated scores)")