【问题标题】:Generate a sequence of numbers between values of vector在向量的值之间生成一系列数字
【发布时间】:2017-09-21 07:42:22
【问题描述】:

我有一个数字向量

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吧?
  • 使用sample(x, replace = T) 将在x 的最小和最大范围内生成数字。虽然,该字符串是您想要生成的确切结果吗?或者通常与sample 具有类似功能的东西?
  • @Frank 返回的向量中应该有一个1作为初始值
  • @Erik-schutte 这正是所需的输出
  • sapply 的另一个选项...不知道为什么它被否决但是:c(1, unlist(sapply(1:(length(x)-1), function(i) head((x[i]:x[i+1]),-1) )), tail(x,1))

标签: r vector sequence


【解决方案1】:

这似乎可行,假设隐式初始值为 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 包,或者更仔细地计算数学。

【讨论】:

  • 我正准备为你解决问题@akrun
  • @989 我不关注。在这种情况下,您期望什么输出?我相信第一个序列从 1 开始,而不是简单地以 1 开头。
  • @989 我的猜测是“否”,根据我对 OP 的编辑说“从 1 开始”。我可能是错的;你可以问 OP。
【解决方案2】:

我们可以使用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

【讨论】:

    【解决方案3】:

    使用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
    

    【讨论】:

      猜你喜欢
      • 2022-12-20
      • 1970-01-01
      • 2014-02-13
      • 1970-01-01
      • 2013-02-03
      • 2010-09-16
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多