0

私は自分で答えを見つけるのに十分長い間苦労しました。解決策から学ぼうとすることを約束します。学習のために、明示的なループでそれを行う方法を理解したいと思いますが、おまけとしてベクトル化されたアプローチを共有したい場合も大歓迎です。

毎日 1 回ゲームをプレイし、毎日の勝利の確率を知っているとします。その確率のベクトルを取り、少なくとも 1 日に成功する累積確率を返す関数が必要です。したがって、3 日間連続でプレイし、毎日の勝利確率が 0.5 の場合、関数は「0.875, 0.75, 0.5」を返す必要があります。

これは、この関数の作成に失敗した最近の試みです。

prob_cum <- function(prob_today) {
  p_cum <- rep(0, length(prob_today))
  for (i in 1:length(prob_today)) {
    for (j in i:length(prob_today)) {
      p_cum[j] <- p_cum[j-1] - ((1 - p_cum[j-1]) * prob_today[j])
    }
  }
  p_cum
}

prob_daily <- c(.5,.5,.5)
prob_cum(prob_daily)
4

2 に答える 2

5 
>  1 - cumprod( 1- c(0.5,0.5,0.5) )
[1] 0.500 0.750 0.875
 # (1- prob_success) is the prob_non_success vector

必要に応じて関数に簡単にラップできます。最初のテストは、cumprod 引数内で 1 から成功ベクトルを差し引かないという私の元のエラーを明らかにしなかったため、適切なものではありませんでした。

 vec<-runif(100)
 prob_cum <- function(prob_today) {
   p_cum <- rep(0, length(prob_today))
   p_cum[1] <- prob_today[1]
   for (j in seq_along(prob_today)[-1]) {
     p_cum[j] <- p_cum[j-1] + ((1 - p_cum[j-1]) * prob_today[j])
   }
   p_cum
 }
 Prob_vec <- function(vec) 1 - cumprod( 1- vec) 
 require(rbenchmark)
 benchmark( prob_cum(vec) , Prob_vec(vec) ,replications=1000)
#           test replications elapsed relative user.self sys.self user.child sys.child
#1 prob_cum(vec)         1000   0.538   59.778     0.532    0.008          0         0
#2 Prob_vec(vec)         1000   0.009    1.000     0.008    0.002          0         0
于 2013-03-27T20:29:03.577 に答える
4

一度に各問題に取り組む:

i何もしないループがあります。同じ計算を複数回実行し、そのたびに結果を (同じ結果で) 上書きするだけです。それをドロップします。

prob_cum <- function(prob_today) {
  p_cum <- rep(0, length(prob_today))
  for (j in i:length(prob_today)) {
    p_cum[j] <- p_cum[j-1] - ((1 - p_cum[j-1]) * prob_today[j])
  }
  p_cum
}

これにはまだ問題があります。の場合、長さ 0 のベクトルj=1にアクセスしようとするp_cum[0]と、計算では長さ 1 のベクトルが想定されます。そのため、エラーメッセージが表示されます

Error in p_cum[j] <- p_cum[j - 1] - ((1 - p_cum[j - 1]) * prob_today[j]) : 
  replacement has length zero

初期化p_cum[1]してから、残りをループします。

prob_cum <- function(prob_today) {
  p_cum <- rep(0, length(prob_today))
  p_cum[1] <- prob_today[1]
  for (j in 2:length(prob_today)) {
    p_cum[j] <- p_cum[j-1] - ((1 - p_cum[j-1]) * prob_today[j])
  }
  p_cum
}

このループ構造は潜在的に危険です。少なくとも長さが 2 である限り機能しprob_todayますが、長さが 1 の場合は予期しない動作をします。

prob_cum <- function(prob_today) {
  p_cum <- rep(0, length(prob_today))
  p_cum[1] <- prob_today[1]
  for (j in seq_along(prob_today)[-1]) {
    p_cum[j] <- p_cum[j-1] - ((1 - p_cum[j-1]) * prob_today[j])
  }
  p_cum
}

ここで、実際の問題に直面します。あなたのアルゴリズムは間違っています。1 日に少なくとも 1 勝するj確率は、 1 日に少なくとも 1 勝する確率に、その時点まで勝利がなかったことを前提として、そのj-1日に 1 勝する確率を加えたものです。jあなたにはマイナスがあります。

prob_cum <- function(prob_today) {
  p_cum <- rep(0, length(prob_today))
  p_cum[1] <- prob_today[1]
  for (j in seq_along(prob_today)[-1]) {
    p_cum[j] <- p_cum[j-1] + ((1 - p_cum[j-1]) * prob_today[j])
  }
  p_cum
}

これで機能する関数ができました:

> prob_cum(prob_daily)
[1] 0.500 0.750 0.875
> prob_cum(c(0.5, 0.01, 0.99))
[1] 0.50000 0.50500 0.99505

完全にベクトル化された解は、確率を別の方法で表現することから導き出されます。少なくとも 1 勝する確率は、1 からその日までにすべて負ける確率を引いたものです。これらは独立した確率であるため、毎日損失を被った結果に過ぎません。

prob_cum <- function(prob_today) {
  1 - cumprod(1-prob_today)
}

同じ結果が得られます

> prob_cum(prob_daily)
[1] 0.500 0.750 0.875
> prob_cum(c(0.5, 0.01, 0.99))
[1] 0.50000 0.50500 0.99505

追加の調整を必要とせずに、単一の値と空のベクトルに対して機能します

> prob_cum(c(0.75))
[1] 0.75
> prob_cum(c())
numeric(0)
于 2013-03-27T20:54:53.740 に答える