我有一个数字向量
x <- c(2,5,1,6)
我正在尝试生成一系列值——从 1 开始——在
x
中的值之间并包括这些值,这样我就剩下以下字符串
1,2,3,4,5,4,3,2,1,2,3,4,5,6
我试图找到执行此任务所需的功能(例如 seq、order、arrange),但我似乎无法找到执行此任务所需的功能。
这似乎可行,假设隐式初始值为 1:
res <- Reduce(function(y, z) c(head(y,-1), tail(y,1):z), x, init=1L)
# 1 2 3 4 5 4 3 2 1 2 3 4 5 6
如果您必须将其作为逗号字符串:
paste(res, collapse=",")
.
对于一个大问题,这将变得非常低效,因为我在循环中增长一个对象。对于这种情况,我建议使用 Rcpp 包,或者更仔细地计算数学。
我们可以使用
Rcpp
实现。如果文件是 'file1.cpp'
#include <Rcpp.h>
//[[Rcpp::export]]
using namespace Rcpp;
// [[Rcpp::export]]
List rleC(NumericVector x) {
std::vector<int> lengths;
std::vector<double> values;
// Initialise first value
int i = 0;
double prev = x[0];
values.push_back(prev);
lengths.push_back(1);
NumericVector::iterator it;
for(it = x.begin() + 1; it != x.end(); ++it) {
if (prev == *it) {
lengths[i]++;
} else {
values.push_back(*it);
lengths.push_back(1);
i++;
prev = *it;
}
}
return List::create(
_["lengths"] = lengths,
_["values"] = values
);
}
// [[Rcpp::export]]
Rcpp::NumericVector newSeq(Rcpp::NumericVector z) {
int zlen = z.length();
Rcpp::List zlist(zlen);
for(int i = 0; i < zlen; i++){
if(z[i+1] > z[i]) {
zlist[i] = Rcpp::seq(z[i], z[i+1]);
} else {
zlist[i] = Rcpp::rev(Rcpp::seq(z[i+1], z[i]));
}
}
Rcpp::Environment stats1("package:base");
Rcpp::Function unlist = stats1["unlist"];
return rleC(unlist(Rcpp::head(zlist, -1)))["values"];
}
我们获取文件
library(Rcpp)
sourceCpp("file1.cpp")
c(1, newSeq(x))
#[1] 1 2 3 4 5 4 3 2 1 2 3 4 5 6
此外,使用
base R
选项(较早删除的答案)
v1 <- rle(unlist(Map(":", x[-length(x)], x[-1])))$values
c(seq(v1[1]), v1[-1])
#[1] 1 2 3 4 5 4 3 2 1 2 3 4 5 6
另一个解决方法是使用
mapply
:
c(1, unlist(mapply(function(s,e) tail(s:e,-1), head(c(1,x),-1), x)))
#[1] 1 2 3 4 5 4 3 2 1 2 3 4 5 6
或
c(seq(x[1]-1),
unlist(sapply(seq(length(x)-1), function(i) head(x[i]:x[i+1], -1))),
tail(x,1))
#[1] 1 2 3 4 5 4 3 2 1 2 3 4 5 6
基准测试(
base
R 解决方案)
library(microbenchmark)
set.seed(1)
x <- sample(1000, 500, replace = FALSE)
f_Frank <- function(x) Reduce(function(y, z) c(head(y,-1), tail(y,1):z), x, init=1L)
f_989_1 <- function(x) c(1, unlist(mapply(function(s,e) tail(s:e,-1), head(c(1,x),-1), x)))
f_989_2 <- function(x)
c(seq(x[1]-1),
unlist(sapply(seq(length(x)-1), function(i) head(x[i]:x[i+1], -1))),
tail(x,1))
f_akrun <- function(x){
v1 <- rle(unlist(Map(":", x[-length(x)], x[-1])))$values
c(seq(v1[1]), v1[-1])
}
r <- f_Frank(x)
all(r==f_989_1(x))
#[1] TRUE
all(r==f_989_2(x))
#[1] TRUE
all(r==f_akrun(x))
#[1] TRUE
res <- microbenchmark(f_Frank(x), f_989_1(x), f_989_2(x), f_akrun(x))
print(res, order="mean")
# Unit: milliseconds
# expr min lq mean median uq max neval
# f_989_1(x) 5.851345 6.113956 6.627022 6.308359 7.256490 9.286613 100
# f_989_2(x) 5.604960 5.794707 7.260833 5.946143 6.876246 58.284487 100
# f_akrun(x) 6.826068 7.726124 13.491295 8.263214 8.983740 63.384959 100
# f_Frank(x) 287.564706 340.390713 351.593511 344.465231 359.258399 454.095461 100
类似于@Mike H. 上面的评论,每个元素都是序列的开始或结束。这种方法对任何数字串都很灵活:
x <- c(2,5,1,6)
xpand <- unlist(lapply(1:(length(x)-1),function(a){x[a]:x[a+1]}))
xpand <- xpand[c(1,diff(xpand))!=0] #remove duplicates
想要序列从1开始,在x的开头绑定一个1即可