0

1と0のベクトルがあると想像してください

私はそれをコンパクトに書きます:

1111111100001111111111110000000001111111111100101

ゼロに続く「N」のベクトルを新しいゼロに置き換える新しいベクトルを取得する必要があります。

たとえば、N=3の場合。

1111111100001111111111110000000001111111111100101は1111111100000001111111110000000000001111111100000になります

forループでそれを行うことはできますが、読んだことは良い習慣ではありません。どうすればそれを行うことができますか?

乾杯

私のベクトルは確かに動物園シリーズですが、違いはないと思います。ゼロまでゼロにしたい場合は、cumprodを使用します。

4

8 に答える 8

5

でこれを行うこともできますrle。必要なのは、値が0のすべての長さにnを加算し、値が1の場合はnを減算することです(行にn未満の場合は少し注意してください)。(Gregの方法を使用してサンプルを作成します)

rr <- rle(tmp)
## Pad so that it always begins with 1 and ends with 1
if (rr$values[1] == 0) {
   rr$values <- c(1, rr$values)
   rr$lengths <- c(0, rr$lengths)  
}
if (rr$values[length(rr$values)] == 0) {
  rr$values <- c(rr$values, 1)
  rr$lengths <- c(rr$lengths, 0)  
}
zero.indices <- seq(from=2, to=length(rr$values), by=2)
one.indices <- seq(from=3, to=length(rr$values), by=2)
rr$lengths[zero.indices] <- rr$lengths[zero.indices] + pmin(rr$lengths[one.indices], n)
rr$lengths[one.indices] <- pmax(0, rr$lengths[one.indices] - n)
inverse.rle(rr)
于 2010-09-10T19:21:29.073 に答える
3

(少数を想定して)N個のインスタンスをループするだけではどうでしょうか。

addZeros <- function(x, N = 3) {
    xx <- x
    z <- x - 1
    for (i in 1:N) {
        xx <- xx + c(rep(0, i), z[-c((NROW(x) - i + 1):NROW(x))])
    }
    xx[xx<0] <- 0
    xx
}

後続のN個の値を減算するには、すべてのゼロインスタンスを-1に変換するだけです。

> x <- c(1,1,1,1,1,1,1,1,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0,1,0,1)
> x
 [1] 1 1 1 1 1 1 1 1 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 1
[39] 1 1 1 1 1 1 0 0 1 0 1
> addZeros(x)
 [1] 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1
[39] 1 1 1 1 1 1 0 0 0 0 0

編集:

R-helpメーリングリストのデータの説明を読んだ後、これは明らかに小さなNの場合ではありません。したがって、このためのC関数を検討することをお勧めします。

ファイル「addZeros.c」:

void addZeros(int *x, int *N, int *n)
{
    int i, j;

    for (i = *n - 1; i > 0; i--)
    {
        if ((x[i - 1] == 0) && (x[i] == 1))
        {
            j = 0;
            while ((j < *N) && (i + j < *n) && (x[i + j] == 1))
            {
                x[i + j] = 0;
                j++;
            }
        }
    }
}

コマンドプロンプト(WindowsのMS DOS、Win + rを押してcmdと入力)に、「RCMDSHLIBaddZeros.c」と入力します。Rへのパスに到達できない場合(つまり、「不明なコマンドR」)、完全なアドレスを指定する必要があります(私のシステムでは:

"c:\Program Files\R\R-2.10.1\bin\R.exe" CMD SHLIB addZeros.c

WindowsではDLL(Linuxでは.so)が生成されますが、R-toolboxがまだない場合は、ダウンロードしてインストールする必要があります(PerlやMingwなどのツールのコレクションです)。http://www.murdoch-sutherland.com/Rtools/から最新バージョンをダウンロードし ます。

このためのRラッパー関数は次のようになります。

addZeros2 <- function(x, N) {
    if (!is.loaded("addZeros"))
        dyn.load(file.path(paste("addZeros", .Platform$dynlib.ext, sep = "")))
    .C("addZeros",
        x = as.integer(x),
        as.integer(N),
        as.integer(NROW(x)))$x
}

setwd("C:/Users/eyjo/Documents/Forrit/R/addZeros")addZeros R関数が最初に呼び出される前に(または、dyn.loaddllファイルへのフルパスを含めるだけで) 、Rの作業ディレクトリは(私のシステム上の)DLLと同じである必要があることに注意してください。これらをプロジェクトの下のサブディレクトリ(つまり「c」)に保持してから、ファイルパスの「addZeros」の前に「c/」を追加することをお勧めします。

説明する:

> x <- rbinom(1000000, 1, 0.9)
>
> system.time(addZeros(x, 10))
   user  system elapsed 
   0.45    0.14    0.59 
> system.time(addZeros(x, 400))
   user  system elapsed 
  15.87    3.70   19.64 
> 
> system.time(addZeros2(x, 10))
   user  system elapsed 
   0.01    0.02    0.03 
> system.time(addZeros2(x, 400))
   user  system elapsed 
   0.03    0.00    0.03 
> 

ここで、「addZeros」は内部Rのみを使用した私の最初の提案であり、addZeros2はC関数を使用しています。

于 2010-09-11T01:01:38.037 に答える
2
x <- c(1,1,1,1,1,1,1,1,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0,1,1,0,1)

n <- 3
z<-rle(x)
tmp <- cumsum(z$lengths)

for (i in seq(which.min(z$values),max(which(z$values==1)),2)) {
         if  (z$lengths[i+1] < n)   x[tmp[i]:(tmp[i] + z$lengths[i+1])] <- 0
         else                       x[tmp[i]:(tmp[i]+n)] <- 0
}
于 2010-09-10T21:33:28.647 に答える
1

これが1つの方法です:

> tmp <- strsplit('1111111100001111111111110000000001111111111100101','')
> tmp <- as.numeric(unlist(tmp))
> 
> n <- 3
> 
> tmp2 <- embed(tmp, n+1)
> 
> tmp3 <- tmp
> tmp3[ which( apply( tmp2, 1, function(x) any(x==0) ) ) + n ] <- 0
> 
> paste(tmp3, collapse='')
[1] "1111111100000001111111110000000000001111111100000"

これがループよりも優れているかどうかはあなた次第です。

そこに0がある場合、これは最初のn個の要素も変更しません。

ここに別の方法があります:

> library(gtools)
> 
> tmpfun <- function(x) {
+ if(any(x==0)) {
+ 0
+ } else {
+ x[length(x)]
+ }
+ }
> 
> tmp4 <- running( tmp, width=4, fun=tmpfun, 
+ allow.fewer=TRUE )
> 
> tmp4 <- unlist(tmp4)
> paste(tmp4, collapse='')
[1] "1111111100000001111111110000000000001111111100000"
> 
于 2010-09-10T18:41:16.137 に答える
1

以前のコメントをフォローアップするために、速度が実際に懸念される場合は、ベクトルを文字列に変換して正規表現を使用すると、他のソリューションよりも高速になる可能性があります。最初の関数:

replaceZero <- function(x,n){
    x <- gsub(paste("01.{",n-1,"}", sep = "") , paste(rep(0,n+1),collapse = ""), x)
}

データを生成する

z <- sample(0:1, 1000000, replace = TRUE)

z <- paste(z, collapse="")
repz <- replaceZero(z,3)
repz <- as.numeric(unlist(strsplit(repz, "")))

崩壊し、正規表現を実行し、ベクトルに分割するシステム時間:

Regex method
   user  system elapsed 
   2.39    0.04    2.39 
Greg's method
   user  system elapsed 
   17.m39    0.17   18.30
Jonathon's method
   user  system elapsed 
   2.47    0.02    2.31 
于 2010-09-10T20:16:13.043 に答える
1

これに「正規表現」を使用するというアイデアが本当に好きなので、私はそれに投票しました。(私もrleの回答を得て、埋め込みと実行中の回答から何かを学んだらいいのにと思います。きちんと!)提起された問題に対処できると思うChaseの回答のバリエーションを次に示します。

replaceZero2 <- function(x, n) {
  if (n == 0) {
    return(x)
  }
  xString <- paste(x, collapse="")
  result <- gsub(paste("(?<=",
             paste("01{", 0:(n - 1), "}", sep="", collapse="|"),
             ")1", sep=""),
       "0", xString, perl=TRUE)
  return(as.numeric(unlist(strsplit(result, ""))))
}

これは、gd047の入力例でn=1,2,3,4,5の場合のChangのrleメソッドと同じ結果を生成するようです。

たぶん、\ Kを使用してこれをよりきれいに書くことができますか?

于 2010-09-12T07:22:28.307 に答える
0

私は自分で解決策を見つけました。とても簡単で、それほど遅くはないと思います。誰かがC++でコンパイルできれば、ループが1つしかないため、非常に高速になると思います。

f5 <- function(z, N) {
   x <- z
   count <- 0
   for (i in 1:length(z)) {
     if (z[i]==0) { count <- N }
     else {
       if (count >0) { 
          x[i] <- 0  
          count <- count-1 }
   }
}
x
}
于 2010-09-12T13:45:59.163 に答える
0

移動最小関数の使用は非常に高速でシンプルであり、スパンの分布に依存しません。

x <- rbinom(1000000, 1, 0.9)
system.time(movmin(x, 3, na.rm=T))
# user  system elapsed 
# 0.11    0.02    0.13 

次のmovminの簡単な定義で十分です(大きなNに対してvan Herk / Gil-Wermanアルゴリズムを使用するなど、完全な関数にはこの場合に不要な機能がいくつかあります)

movmin = function(x, n, na.rm=F) {
  x = c(rep.int(NA, n - 1), x) # left pad
  do.call(pmin, c(lapply(1:n, function(i) x[i:(length(x) - n + i)]), na.rm=na.rm))
}

ゼロに続く3つの値に影響を与えるため、実際には4のウィンドウサイズが必要です。これはあなたのf5と一致します:

x <- rbinom(1000000, 1, 0.9)
all.equal(f5(x, 3), movmin(x, 4, na.rm=T))
# [1] TRUE
于 2010-09-14T19:56:27.160 に答える