4

ep.dur数日間の観察期間で、1 日あたりのエピソードの持続時間 (分単位のベクトル) を測定していT=364ます。ベクトルep.durlength(ep.dur)_ T=364_ range(ep.dur)_

T 期間にわたるエピソード期間の合計はa<-sum(ep.duration)

今、私は ベクトル を持っていdenますlength(den)=99。ベクトル den は、各 1% (1%、2%、3%、...) の開発に必要な日数を示しています。a

と が与えられた ので、複数をシミュレートしたいとden思いますaep.dur

これは可能ですか?

明確化 1: : (danas.zuokas の最初のコメント) の要素は、正確な日数ではなく期間denを表します。つまり、たとえば 1、1%(=1195.8) が 1 日で、2% が 2 日で、3% が 3 日で、4% が 4 日で、5% が5 日で、6% が5 日で開発されることを意味します。 .....)。エピソードは T のどこでも発生する可能性がありますa

明確化 2: (danas.zuokas の 2 番目のコメント) 残念ながら、期間がどのように発展するかについての仮定はありません。そのため、多数の ep.dur ベクトルをシミュレートする必要があります。ただし、これが役立つ場合は、デンベクトルをより有限の解像度に拡張できます (つまり、1% のジャンプではなく、0.1% のジャンプ)。

アルゴリズムの説明 アルゴリズムは、den ベクトルが提供するすべての情報を満たす必要があります。アルゴリズムが次のようになると想像しました (例 3): a の 1% の各ジャンプは 335.46 分です。den[1]は、a の 1% が 1 日で開発されることを示しています。ep.dur[1]=335,46を生成するとします。わかった。den[2]: a の 2% は =1 日で開発されますd[2]。そのため、ep.dur[1]335,46 にすることはできず、拒否されます (a の 2% は 1 日で発生するはずです)。ep.dur[1]=1440を生成したとしましょう。d[1]満足している、満足してd[2]いる (合計期間の少なくとも 2% がdur[2]=1 日で開発されている)、dur[3]=1 も満足しています。キーパー?ただし、dur[4]ep.dur[1]=1440 の場合、=2 は成立しません。これは、a (=1341) の 4% が 2 日で発生する必要があることを示しているためです。そうep.dur[1]拒否されます。ep.dur[1]ここで、 =1200としましょう。dur[1:3]受け入れられます。次にep.dur[2]、生成された ep.dur がすべて den によって提供された情報を満たしていることを確認します。

これはプログラム的に実行可能ですか? この問題をどこから始めればよいか本当にわかりません。バウンティ開始期間が終了したら、寛大なバウンティを提供します

例 1:

a<-119508

den<-c(1, 2, 3, 4, 5, 5, 6, 7, 8, 9, 10, 10, 11, 12, 13, 14, 15, 15, 
                16, 17, 18, 19, 20, 20, 21, 22, 23, 24, 25, 25, 26, 27, 28, 29, 
                30, 30, 31, 32, 33, 34, 35, 35, 36, 37, 38, 39, 40, 40, 41, 42, 
                43, 44, 45, 45, 46, 47, 48, 49, 50, 50, 51, 52, 53, 54, 55, 55, 
                56, 57, 58, 59, 60, 60, 61, 62, 63, 64, 65, 65, 66, 67, 68, 69, 
                70, 70, 71, 72, 73, 74, 75, 75, 76, 77, 78, 79, 80, 80, 81, 82, 
                83)

例 2:

   a<-78624
    den<-c(1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 
    11, 12, 13, 13, 14, 14, 15, 15, 16, 16, 17, 18, 19, 21, 22, 23, 
    28, 32, 35, 36, 37, 38, 43, 52, 55, 59, 62, 67, 76, 82, 89, 96, 
    101, 104, 115, 120, 126, 131, 134, 139, 143, 146, 153, 160, 165, 
    180, 193, 205, 212, 214, 221, 223, 227, 230, 233, 234, 235, 237, 
    239, 250, 253, 263, 269, 274, 279, 286, 288, 296, 298, 302, 307, 
    309, 315, 320, 324, 333, 337, 342, 347, 352)

例 3

a<-33546
den<-c(1, 1, 1, 2, 4, 6, 8, 9, 12, 15, 17, 21, 25, 29, 31, 34, 37, 
42, 45, 46, 51, 52, 56, 57, 58, 59, 63, 69, 69, 71, 76, 80, 81, 
87, 93, 95, 102, 107, 108, 108, 112, 112, 118, 123, 124, 127, 
132, 132, 132, 135, 136, 137, 150, 152, 162, 166, 169, 171, 174, 
176, 178, 184, 189, 190, 193, 197, 198, 198, 201, 202, 203, 214, 
218, 219, 223, 225, 227, 238, 240, 246, 248, 251, 254, 255, 257, 
259, 260, 277, 282, 284, 285, 287, 288, 290, 294, 297, 321, 322, 
342)

例 4

    a<-198132

den<-c(2, 3, 5, 6, 7, 9, 10, 12, 13, 14, 16, 17, 18, 20, 21, 23, 24, 
    25, 27, 28, 29, 31, 32, 34, 35, 36, 38, 39, 40, 42, 43, 45, 46, 
    47, 49, 50, 51, 53, 54, 56, 57, 58, 60, 61, 62, 64, 65, 67, 68, 
    69, 71, 72, 74, 75, 76, 78, 79, 80, 82, 83, 85, 86, 87, 89, 90, 
    91, 93, 94, 96, 97, 98, 100, 101, 102, 104, 105, 107, 108, 109, 
    111, 112, 113, 115, 116, 120, 123, 130, 139, 155, 165, 172, 176, 
    178, 181, 185, 190, 192, 198, 218)
4

2 に答える 2

3

私はおそらく Ruby スクリプトでこれを行うでしょうが、それも行うことができますR。あなたの宿題の問題かどうかわかりません。あなたの質問に答えるために:これは問題なく行うことができますか?はい、もちろん!

denあなたの問題によると、私の解決策は、ベクトルとa値で指定された条件を満たすパーセンテージをランダムに選択できる最小制限と最大制限を定義することです。

ベクトルには 99% の値しか含まれていないためden、いつ 100% になるかはわかりません。この条件により、私のソリューションは 3 つの部分に分割されます。別の関数を定義して、これら 3 つの部分すべてに共通のコードを配置することもできますが、まだ行っていません。

コマンドを使用runifして乱数を生成するため、下限が与えられているため、正確な下限値が生成される可能性は低いです。したがって、threshold確認できる値を定義しました。それを下回る場合は、0 にします。これを使用するか、削除することができます。また、例 4 を考慮すると、最初の 1% は 2 日目に発生します。つまり、1 日目にエピソードの最大 0.999999% を含めることができ、2 日目に 1% が発生することを意味します。smallestdiffこれが、変更可能な値を減算することによって上限が定義される理由です。

FindMinutes=function(a,den){
  if (a>1440*364){
    Print("Invalid value for aa")
    return("Invalid value for aa")
  }
  threshold=1E-7
  smallestdiff=1E-6
  sum_perc=0.0
  start=1 #day 1
  min=0 #minimum percentage value for a day
  max=0 #maximum percentage value for a day
  days=rep(c(0),364) #day vector with percentage of minutes - initialized to 0

  maxperc=1440*100/a #maximum percentage wrto 1440 minutes/day

  #############################################################
  #############################################################
  ############ For the length of den vector ###################
  for (i in 1:length(den)){
    if (den[i]>start){   
      min=(i-1)-sum_perc
      for(j in start:(den[i]-1)){#number of days in-between
         if (j>start){ min=0 }
         if (i-smallestdiff-sum_perc>=maxperc){
           max=maxperc
           if ((i-smallestdiff-sum_perc)/(den[i]-j)>=maxperc){
              min=maxperc
           }else{
              if ((i-smallestdiff-sum_perc)/(den[i]-j-1)<maxperc){
                 min=maxperc-(i-smallestdiff-sum_perc)/(den[i]-j-1)
               }else{
                 min=maxperc
               }           
           }
         }else{     
           max=i-smallestdiff-sum_perc
         }  

         if ((r=runif(1,min,max))>=threshold){
            days[j]=r
            sum_perc=sum_perc+days[j]
         }else{
            days[j]=0.0
         }
      }
      start=den[i]
    }
  }
  #############################################################
  #############################################################
  #####################For the 99% ############################
  min=99-sum_perc
  for(j in start:den[length(den)]){
    if (j>start){
           min=0
    }
    max=100-sum_perc
    if (100-sum_perc>=maxperc){
        max=maxperc
        if ((100-sum_perc)/(364+1-j)>=maxperc){
            min=maxperc
        }else{
            if ((100-sum_perc)/(364-j)<maxperc){
               min=maxperc-(100-sum_perc)/(364-j)
            }else{
               min=maxperc
            }           
        }
    }else{
        max=100-sum_perc
    }
    if ((r=runif(1,min,max))>=threshold){
        days[j]=r
        sum_perc=sum_perc+days[j]
    }else{
        days[j]=0.0
    }
  }
  #############################################################
  #############################################################
  ##################### For the remaining 1%###################
  min=0
  for(j in den[length(den)]+1:364){
      max=100-sum_perc
      if (j==364){
        min=max
        days[j]=min      
      }else{
        if (100-sum_perc>maxperc){
           max=maxperc
           if ((100-sum_perc)/(364+1-j)>=maxperc){
              min=maxperc
           }else{
              if ((100-sum_perc)/(364-j)<maxperc){
                 min=maxperc-(100-sum_perc)/(364-j)
               }else{
                 min=maxperc
               }           
           }
        }else{
           max=100-sum_perc
        }
        if ((r=runif(1,min,max))>=threshold){
           days[j]=r
        }else{
           days[j]=0.0
        }
    }
    sum_perc=sum_perc+days[j]  
    if (sum_perc>=100.00){
       break
    }  
  }
  return(days*a/100) #return as minutes vector corresponding to each 364 days
}#function     

私のコードでは、最小値と最大値に従って、毎日のエピソードのパーセンテージ値をランダムに生成します。denまた、パーセンテージ値を整数 ( vector ) に丸めた場合、条件 ( vector ) は適切に保持されdaysますが、必要に応じて追加の調整が必要になる場合があります (これは、さらに先のベクトルをチェックしてdenからパーセンテージの最小値を再調整することに依存します)。小数点以下数桁まで正確です。sum(FindMinutes(a,den))が と等しいことを確認することもできますa。0.1% で定義したい場合はden、そうすることができますが、対応する方程式を変更する必要があります (minおよびmax) 。

最悪のシナリオの例として、aそれが取ることができる最大値と対応するdenベクトルとして作成した場合:

a=1440*364
den<-c(0)
cc=1
for(i in 1:363){
 if (trunc(i*1440*100/(1440*364))==cc){
  den[cc]=i
  cc=cc+1
 }
}

関数を呼び出して上記の例を実行できます。maxexamplemin=FindMinutes(a,den) すべての日の最大分数が 1440 分であることを確認できます。これが唯一の可能なシナリオです。

例として、例 3 を実行させてください。

a<-33546
den<-c(1, 1, 1, 2, 4, 6, 8, 9, 12, 15, 17, 21, 25, 29, 31, 34, 37, 42, 45, 46, 51, 52, 56, 57, 58, 59, 63, 69, 69, 71, 76, 80, 81, 87, 93, 95, 102, 107, 108, 108, 112, 112, 118, 123, 124, 127, 132, 132, 132, 135, 136, 137, 150, 152, 162, 166, 169, 171, 174, 176, 178, 184, 189, 190, 193, 197, 198, 198, 201, 202, 203, 214, 218, 219, 223, 225, 227, 238, 240, 246, 248, 251, 254, 255, 257, 259, 260, 277, 282, 284, 285, 287, 288, 290, 294, 297, 321, 322, 342)
rmin=FindMinutes(a,den)
sum(rmin)
[1] 33546
rmin2=FindMinutes(a,den)
rmin3=FindMinutes(a,den)
plot(rmin,tpe="h")
par(new=TRUE)
plot(rmin2,col="red",type="h")
par(new=TRUE)
plot(rmin3,col="red",type="h")

重ね合わせた 3 つのプロットを以下に示します。 例 3 の 3 つのシミュレーションの重ね合わせプロット

于 2012-06-04T19:48:40.920 に答える
3

あなたが何を求めているかを理解している限りdenrleオブジェクトに変換することから始めます。(ここでは例 3のデータを使用)

編集: 364 日目に 100% を追加den

if(max(den)!=364) den <- c(den, 364)
(rleDen <- rle(den))
# Run Length Encoding
#   lengths: int [1:92] 3 1 1 1 1 1 1 1 1 1 ...    # 92 intervals
#   values : num [1:92] 1 2 4 6 8 9 12 15 17 21 ...
percDur <- rleDen$lengths            # Percentage of total duration in each interval
atDay <- rleDen$values               # What day that percentage was reached
intWidth <- diff(c(0, atDay), k = 1) # Interval width
durPerDay <- 1440                    # Max observation time per day
percPerDay <- durPerDay/a*100        # Max percentage per day
cumPercDur <- cumsum(percDur)        # Cumulative percentage in each interval
maxPerInt <- pmin(percPerDay * diff(c(0, atDay), 1),
  percDur + 1)                       # Max percent observation per interval

set.seed(1)
nsims <- 10                          # Desired number of simulations
sampMat <- matrix(0, ncol = length(percDur), nrow = nsims) # Matrix to hold sim results

1 日あたり最大 1440 分の観測という制限を考慮しながらランダム性を考慮に入れるために、長い間隔 (つまり、その間隔でパーセンテージのジャンプを完全に達成できない間隔) がないかどうかを確認します。

if(any(percDur > maxPerInt)){
  longDays <- percDur > maxPerInt
  morePerInt <- maxPerInt - percDur
  perEnd <- c(which(diff(longDays,1) < 0), length(longDays))
# Group intervals into periods bounded by "long" days
# and determine if there are any long periods (i.e., where
# the jump in percentage can't be achieved in that period)
  perInd <- rep(seq_along(perEnd), diff(c(0, perEnd)))
  perSums <- tapply(percDur, perInd, sum)
  maxPerPer <- tapply(maxPerInt, perInd, sum)
  longPers <- perSums > maxPerPer
# If there are long periods, determine, starting with the last period, when the
# excess can be covered. Each group of periods is recorded in the persToWatch
# object
  if(any(longPers)) {
    maxLongPer <- perEnd[max(which(longPers))]
    persToWatch <- rep(NA, length(maxLongPer))
    for(kk in rev(seq_len(maxLongPer))) {
      if(kk < maxLongPer && min(persToWatch, na.rm = TRUE) <= kk) next
        theSums <- cumsum(morePerInt[order(seq_len(kk),
          decreasing = TRUE)])
        above0 <- which(rev(theSums) > 0)
        persToWatch[kk] <- max(above0[which(!perInd[above0] %in% c(perInd[kk],
          which(longPers)) & !above0 %in% which(longDays))])
    }
  }
}

これで、ランダム性を開始できます。サンプリングの最初のコンポーネントは、各間隔で発生する全体的な比率を決定しaます。いくら?runif決めましょう。上限と下限は、1 日あたりの最大観測時間と、長い日と期間の超過量を反映する必要があります。

  for(jj in seq_along(percDur[-1])) {
    upperBound <- pmin(sampMat[, jj] + maxPerInt[jj],
      cumPercDur[jj] + 1)
    lowerBound <- cumPercDur[jj]
# If there are long days, determine the interval over which the
# excess observation time may be spread
    if(any(percDur > maxPerInt) && any(which(longDays) >= jj)) {
      curLongDay <- max(which(perInd %in% perInd[jj]))
      prevLongDay <- max(0, min(which(!longDays)[which(!longDays) <= jj]))
      curInt <- prevLongDay : curLongDay
# If there are also long periods, determine how much excess observation time there is
      if(any(longPers) && maxLongPer >= jj) {
        curLongPerHigh <- min(which(!is.na(persToWatch))[
          which(!is.na(persToWatch)) >= jj])
        curLongPerLow <- persToWatch[curLongPerHigh]
        longInt <- curLongPerLow : curLongPerHigh
        curExtra <- max(0,
          cumPercDur[curLongPerHigh] - 
          sum(maxPerInt[longInt[longInt > jj]]) - 
          sampMat[, jj, drop = FALSE])
      } else {
        curExtra <- cumPercDur[curLongDay] - 
          (sum(maxPerInt[curInt[curInt > jj]]) +
          sampMat[, jj, drop = FALSE])
      }
# Set the lower limit for runif appropriately
      lowerBound <- sampMat[, jj, drop = FALSE] + curExtra
    }
# There may be tolerance errors when the observations are tightly
# packed
    if(any(lowerBound - upperBound > 0)) { 
      if(all((lowerBound - upperBound) <= .Machine$double.eps*2*32)) {
        upperBound <- pmax(lowerBound, upperBound)
      } else {
        stop("\nUpper and lower bounds are on the wrong side of each other\n",
          jj,max(lowerBound - upperBound))
      }
    }
    sampMat[, jj + 1] <- runif(nsims, lowerBound, upperBound)
  }

次に、結果の末尾に 100% を追加し、間隔固有のパーセンテージを計算します。

  sampMat2 <- cbind(sampMat[, seq_along(percDur)], 100)
  sampPercDiff <- t(apply(sampMat2, 1, diff, k = 1))

ランダム性の2 番目sampPercDiffのコンポーネントは、間隔 widthsの分布を決定しますintWidth。私の意見では、これはまだもっと考える必要があります。たとえば、検討中の時間単位と比較して、典型的なエピソードはどのくらい続きますか?

間隔ごとに、ランダムなパーセンテージを複数の時間単位 (この場合は日) に割り当てる必要があるかどうかを判断します。編集:次のコードを変更して、 の場合のパーセンテージの増加を制限しましたintWidth > 1

library(foreach)
  ep.dur<-foreach(ii = seq_along(intWidth),.combine=cbind)%do%{
    if(intWidth[ii]==1){
      ret<-sampPercDiff[, ii, drop = FALSE] * a / 100
      dimnames(ret)<-list(NULL,atDay[ii])
      ret
    } else {
      theDist<-matrix(numeric(0), ncol = intWidth[ii], nrow = nsims)
      for(jj in seq_len(intWidth[ii]-1)){
        theDist[, jj] <- floor(runif(nsims, 0, pmax(0,
          min(sampPercDiff[, ii], floor(sampMat2[,ii + 1])-.Machine$double.eps -
          sampMat2[,ii]) * a / 100 - rowSums(theDist, na.rm = TRUE))))
      }
      theDist[, intWidth[ii]] <- sampPercDiff[, ii] * a / 100 - rowSums(theDist,
        na.rm = TRUE)
      distOrder <- replicate(nsims, c(sample.int(intWidth[ii] - 1),
        intWidth[ii]), simplify = FALSE)
      ret <- lapply(seq_len(nrow(theDist)), function(x) {
        theDist[x, order(distOrder[[x]])]
      })
      ans <- do.call(rbind, ret)
      dimnames(ans) <- list(NULL, atDay[ii]-((intWidth[ii]:1)-1))
      ans
    }
  }

継続時間は、それが分配される間隔の時間単位 (日) ごとにランダムにサンプリングされます。合計期間を毎日の観測時間に分割した後、これらは間隔内の日にランダムに割り当てられます。


次に、サンプリングされて分散されたパーセンテージに を掛け、a100 で割ります。

ep.dur[1, 1 : 6]
#         1         2         3         4         5         6 
# 1095.4475  315.4887    1.0000  578.9200   13.0000  170.6224 

ncol(ep.dur)
# [1] 364

apply(ep.dur, 1, function(x) length(which(x == 0)))
# [1] 131 133 132 117 127 116 139 124 124 129

rowSums(ep.dur)/a
# [1] 1 1 1 1 1 1 1 1 1 1

plot(ep.dur[1, ], type = "h", ylab = "obs time")

さらに新しいサンプル

于 2012-05-30T22:15:41.733 に答える