Run-length encoding

Task

Given a vector x, create vector fx.

rle()

x <- c(rep(0, 5), rep(1, 4), rep(0, 6), rep(1, 4), rep(0, 3), rep(1, 4))
x

 [1] 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0 1 1 1 1 0 0 0 1 1 1 1


x.rle <- rle(x)
x.rle

Run Length Encoding
  lengths: int [1:6] 5 4 6 4 3 4
  values : num [1:6] 0 1 0 1 0 1


##vec.ab <- car::recode(x, '0 = "a"; 1 = "b"')
vec.ab <- c("a","b")[x+1]
vec.ab

 [1] "a" "a" "a" "a" "a" "b" "b" "b" "b" "a" "a" "a" "a" "a" "a" "b" "b" "b" "b" "a" "a" "a" "b" "b" "b" "b"


vec.num <- rep(rep(1:3, each = 2), x.rle$lengths)
vec.num

 [1] 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3


vec.ab.num <- paste(vec.ab, vec.num, sep = "")
vec.ab.num

 [1] "a1" "a1" "a1" "a1" "a1" "b1" "b1" "b1" "b1" "a2" "a2" "a2" "a2" "a2" "a2" "b2" "b2" "b2" "b2" "a3" "a3" "a3"
[23] "b3" "b3" "b3" "b3"


data.frame(x = x, fx = vec.ab.num)

rle() and expand.grid()

x <- c(rep(0, 5), rep(1, 4), rep(0, 6), rep(1, 4), rep(0, 3), rep(1, 4))
x

 [1] 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0 1 1 1 1 0 0 0 1 1 1 1


x.rle <- rle(x)
x.rle

Run Length Encoding
  lengths: int [1:6] 5 4 6 4 3 4
  values : num [1:6] 0 1 0 1 0 1


df <- expand.grid(ab = c("a","b"), num = 1:10)[rep(1:6, x.rle$lengths),]
df


data.frame(x = x, fx = with(df, paste(ab, num, sep = "")))

mapply() and outer() solution

data.frame(x = x,
           fx = unlist(
               mapply(
                   rep,
                   outer(c("a","b"), 1:100, paste, sep="")[seq(rle(x)$lengths)],
                   rle(x)$lengths
                   )
               )
           )

    x fx
a11 0 a1
a12 0 a1
a13 0 a1
a14 0 a1
a15 0 a1
b11 1 b1
b12 1 b1
b13 1 b1
b14 1 b1
a21 0 a2
a22 0 a2
a23 0 a2
a24 0 a2
a25 0 a2
a26 0 a2
b21 1 b2
b22 1 b2
b23 1 b2
b24 1 b2
a31 0 a3
a32 0 a3
a33 0 a3
b31 1 b3
b32 1 b3
b33 1 b3
b34 1 b3



outer(c("a","b"), 1:100, paste, sep="")

     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14] [,15] [,16] [,17] [,18] [,19] [,20]
[1,] "a1" "a2" "a3" "a4" "a5" "a6" "a7" "a8" "a9" "a10" "a11" "a12" "a13" "a14" "a15" "a16" "a17" "a18" "a19" "a20"
[2,] "b1" "b2" "b3" "b4" "b5" "b6" "b7" "b8" "b9" "b10" "b11" "b12" "b13" "b14" "b15" "b16" "b17" "b18" "b19" "b20"
     [,21] [,22] [,23] [,24] [,25] [,26] [,27] [,28] [,29] [,30] [,31] [,32] [,33] [,34] [,35] [,36] [,37] [,38]
[1,] "a21" "a22" "a23" "a24" "a25" "a26" "a27" "a28" "a29" "a30" "a31" "a32" "a33" "a34" "a35" "a36" "a37" "a38"
[2,] "b21" "b22" "b23" "b24" "b25" "b26" "b27" "b28" "b29" "b30" "b31" "b32" "b33" "b34" "b35" "b36" "b37" "b38"
     [,39] [,40] [,41] [,42] [,43] [,44] [,45] [,46] [,47] [,48] [,49] [,50] [,51] [,52] [,53] [,54] [,55] [,56]
[1,] "a39" "a40" "a41" "a42" "a43" "a44" "a45" "a46" "a47" "a48" "a49" "a50" "a51" "a52" "a53" "a54" "a55" "a56"
[2,] "b39" "b40" "b41" "b42" "b43" "b44" "b45" "b46" "b47" "b48" "b49" "b50" "b51" "b52" "b53" "b54" "b55" "b56"
     [,57] [,58] [,59] [,60] [,61] [,62] [,63] [,64] [,65] [,66] [,67] [,68] [,69] [,70] [,71] [,72] [,73] [,74]
[1,] "a57" "a58" "a59" "a60" "a61" "a62" "a63" "a64" "a65" "a66" "a67" "a68" "a69" "a70" "a71" "a72" "a73" "a74"
[2,] "b57" "b58" "b59" "b60" "b61" "b62" "b63" "b64" "b65" "b66" "b67" "b68" "b69" "b70" "b71" "b72" "b73" "b74"
     [,75] [,76] [,77] [,78] [,79] [,80] [,81] [,82] [,83] [,84] [,85] [,86] [,87] [,88] [,89] [,90] [,91] [,92]
[1,] "a75" "a76" "a77" "a78" "a79" "a80" "a81" "a82" "a83" "a84" "a85" "a86" "a87" "a88" "a89" "a90" "a91" "a92"
[2,] "b75" "b76" "b77" "b78" "b79" "b80" "b81" "b82" "b83" "b84" "b85" "b86" "b87" "b88" "b89" "b90" "b91" "b92"
     [,93] [,94] [,95] [,96] [,97] [,98] [,99] [,100]
[1,] "a93" "a94" "a95" "a96" "a97" "a98" "a99" "a100"
[2,] "b93" "b94" "b95" "b96" "b97" "b98" "b99" "b100"


outer(c("a","b"), 1:100, paste, sep="")[seq(rle(x)$lengths)]

[1] "a1" "b1" "a2" "b2" "a3" "b3"


rle(x)$lengths

[1] 5 4 6 4 3 4


## It reduces to the below, which is then unlist()ed.
mapply(rep, c("a1", "b1", "a2", "b2", "a3"), c(5, 4, 6, 4, 3))

$a1
[1] "a1" "a1" "a1" "a1" "a1"

$b1
[1] "b1" "b1" "b1" "b1"

$a2
[1] "a2" "a2" "a2" "a2" "a2" "a2"

$b2
[1] "b2" "b2" "b2" "b2"

$a3
[1] "a3" "a3" "a3"

Actually worked without mapply()

data.frame(x = x,
           fx = rep(
               outer(c("a","b"), 1:100, paste, sep="")[seq(rle(x)$lengths)],
               rle(x)$lengths
               )
           )

Solution without 1:100

data.frame(x = x,
           fx = rep(
               outer(c("a","b"), seq(ceiling(length(rle(x)$lengths)/2)), paste, sep="")[seq(rle(x)$lengths)],
               rle(x)$lengths
               )
           )