r - 将一个数据帧强制转换为另一个数据帧的结构

Question

我希望根据某些标准强制一个数据框适应另一个数据框的结构

示例数据

## to be populated:
df_final <- data.frame("a"=numeric(), "b"=numeric(), "c"=numeric(), 
                       "l"=integer(), "m"=integer(), "n"=integer(), 
                       "x"=numeric(), "y"=numeric(), "z"=numeric())

> df_final
[1] a b c l m n x y z
<0 rows> (or 0-length row.names)

## data to coerce into df_final
df_data <- data.frame(col1=c(21.3,23.1,22.2),
                      col2=c(23.22,64.2,46.2), 
                      col3=c(NA_integer_,2L,3L), 
                      col4=c(23.2, 90.2,9.1))

> df_data
  col1  col2 col3 col4
1 21.3 23.22   NA 23.2
2 23.1 64.20    2 90.2
3 22.2 46.20    3  9.1

df_data 有三组“列”：

1. set1：最多 3 列将是“十进制数”（最左侧的列）
2. set2：最多 3 列是整数
3. set3：最多 3 列将是“十进制数”（最右边的列）

但是，df_data 并不总是有 9 列，并且某些列中可能会丢失一些数据（如示例中所示）。并且df_data 的列名将与df_final 中的不匹配

我需要根据规则将df_data“匹配”到df_final：

1. a, b, c 列将包含来自 set1 的“十进制数字”
2. l, m, n 列将仅包含来自 set2 的整数
3. x, y, z 列将包含来自 set3 的“十进制数”

df_data 每组的列少于 3 列，我希望 df_fnal 中缺少的列为 NA

所以我的结果是

> df_final
   a    b     c  l  m  n  x  y    z
1 NA 21.3 23.22 NA NA NA NA NA 23.2
2 NA 23.1 64.20 NA NA  2 NA NA 90.2
3 NA 22.2 46.20 NA NA  3 NA NA  9.1

我不确定这样做的最佳方式；目前我正在考虑在每一行上使用正则表达式，在“整数”之前找到所有“小数”数字，然后是所有整数，然后是整数之后的所有“小数”，但目前这似乎过于复杂，而且我我希望有一个我忽略的更简单的方法？

Answer 1

此解决方案仅依赖于 R 能够识别 df_data 中的整数列。它可能会失败，因为其中一列没有被读取为整数（例如，如果它充满了 NA）。

nr <- nrow(df_data)

# Define rows corresponding to sets 1,2,3
set2 <- which(sapply(df_data, class) == "integer")
set1 <- 1:(min(set2)-1)
set3 <- (max(set2)+1):length(df_data)

# Build the three components of df_final
part1 <- cbind(matrix(NA_real_, nrow=nr, ncol=3-length(set1)), df_data[,set1])
part2 <- cbind(matrix(NA_integer_, nrow=nr, ncol=3-length(set2)), df_data[,set2])
part3 <- cbind(matrix(NA_integer_, nrow=nr, ncol=3-length(set3)), df_data[,set3])

# Put it together and save column names
df_final <- data.frame(part1, part2, part3)
colnames(df_final) <- c("a","b","c","l","m","n","x","y","z")

结果：

> df_final
   a    b     c  l  m  n  x  y    z
1 NA 21.3 23.22 NA NA NA NA NA 23.2
2 NA 23.1 64.20 NA NA  2 NA NA 90.2
3 NA 22.2 46.20 NA NA  3 NA NA  9.1

Answer 2

在我看来，使用 NA 预分配 df_final 然后索引分配来自 df_data 的列是最有意义的。唯一的技巧是确定需要分配哪些列。

我看到您想要右对齐（可以这么说）列集中的列。因此，要求相当于我将在df_final 的反转列类型中描述为df_data 的反转列类型的“累积匹配”。也就是说，你需要从右到左依次遍历df_data和df_final这两个列类型，找到下一个（从右方向）匹配。

我知道R中的各种非累积/累积函数对，例如sum()/cumsum()、prod()/cumprod()、min()/cummin()和max()/ cummax()（实际上我认为只有这些），但是似乎没有任何“累积匹配”功能。所以我自己写了：

cummatch <- function(small,big) {
    cur <- 1L;
    res <- integer();
    biglen <- length(big);
    for (s in small) {
        if (cur > biglen) break;
        rescur <- match(s,big[cur:biglen])+cur-1L;
        if (is.na(rescur)) break;
        res[length(res)+1L] <- rescur;
        cur <- rescur+1L;
    };
    length(res) <- length(small);
    return(res);
};

现在我们可以使用它来获取要分配的列索引：

cis <- ncol(df_final)+1L-rev(cummatch(rev(sapply(df_data,typeof)),rev(sapply(df_final,typeof))));
cis;
## [1] 2 3 6 9
df_final[nrow(df_data),1] <- NA; ## preallocate rows of NA
df_final;
##    a  b  c  l  m  n  x  y  z
## 1 NA NA NA NA NA NA NA NA NA
## 2 NA NA NA NA NA NA NA NA NA
## 3 NA NA NA NA NA NA NA NA NA
df_final[cis] <- df_data;
df_final;
##    a    b     c  l  m  n  x  y    z
## 1 NA 21.3 23.22 NA NA NA NA NA 23.2
## 2 NA 23.1 64.20 NA NA  2 NA NA 90.2
## 3 NA 22.2 46.20 NA NA  3 NA NA  9.1

---

从性能的角度来看，我的 cummatch() 函数可能很糟糕，考虑到所有 R 级循环和函数调用（例如，在 big 的子向量上重复调用 match()）。我最近一直在玩 Rcpp，因此决定尝试在 Rcpp 中编写一个性能更高的版本。我参考how can I handle vectors without knowing the type in Rcpp 试图弄清楚如何编写一个与向量类型无关的函数，解决方案有点hacky，涉及一个C++ 模板函数和switches 在TYPEOF() 上的包装函数向量，因此基本上必须为switch 中的每个case 实例化一个单独的函数调用。我的函数需要两个向量参数，所以 RCPP_RETURN_VECTOR() 宏实际上不足以满足它，但由于两个向量必须是相同类型（用于匹配），我能够按摩宏以使用两个参数而不是一个.这涉及在其中一个宏中手动应用 R 类型提升规则，我很确定我做对了。不用说，这可能已经达到（或超过）对 Rcpp 合理的限制。无论如何，这里是：

cppFunction('

    using namespace Rcpp;

    #define ___RCPP_HANDLE_CASE___2( ___RTYPE___ , ___FUN___ , ___OBJECT___1 , ___OBJECT___2 , ___RCPPTYPE___ ) \\
        case ___RTYPE___ : \\
            return ___FUN___( ::Rcpp::___RCPPTYPE___< ___RTYPE___ >( ___OBJECT___1 ), ::Rcpp::___RCPPTYPE___< ___RTYPE___ >( ___OBJECT___2 ) ) ;

    #define ___RCPP_RETURN___2( __FUN__, __SEXP__1 , __SEXP__2, __RCPPTYPE__ ) \\
        SEXP __TMP__1 = __SEXP__1 ; \\
        SEXP __TMP__2 = __SEXP__2 ; \\
        unsigned int __TMP__1_TYPE = TYPEOF( __TMP__1 ); \\
        unsigned int __TMP__2_TYPE = TYPEOF( __TMP__2 ); \\
        unsigned int __TMP__TYPE = __TMP__1_TYPE == RAWSXP ? __TMP__2_TYPE : __TMP__2_TYPE == RAWSXP ? __TMP__1_TYPE : std::max(__TMP__1_TYPE,__TMP__2_TYPE); /* note: the SEXPTYPE enumeration order *almost* aligns with the R type promotion rules; only raw is out-of-order, so we can test for that first, then use std::max() */ \\
        if (__TMP__1_TYPE < LGLSXP || __TMP__2_TYPE < LGLSXP) __TMP__TYPE = 0; \\
        switch( __TMP__TYPE ) { \\
            ___RCPP_HANDLE_CASE___2( INTSXP  , __FUN__ , __TMP__1 , __TMP__2 , __RCPPTYPE__ ) \\
            ___RCPP_HANDLE_CASE___2( REALSXP , __FUN__ , __TMP__1 , __TMP__2 , __RCPPTYPE__ ) \\
            ___RCPP_HANDLE_CASE___2( RAWSXP  , __FUN__ , __TMP__1 , __TMP__2 , __RCPPTYPE__ ) \\
            ___RCPP_HANDLE_CASE___2( LGLSXP  , __FUN__ , __TMP__1 , __TMP__2 , __RCPPTYPE__ ) \\
            ___RCPP_HANDLE_CASE___2( CPLXSXP , __FUN__ , __TMP__1 , __TMP__2 , __RCPPTYPE__ ) \\
            ___RCPP_HANDLE_CASE___2( STRSXP  , __FUN__ , __TMP__1 , __TMP__2 , __RCPPTYPE__ ) \\
            /* no == for generic ___RCPP_HANDLE_CASE___2( VECSXP  , __FUN__ , __TMP__1 , __TMP__2 , __RCPPTYPE__ ) */ \\
            /* no == for expression ___RCPP_HANDLE_CASE___2( EXPRSXP , __FUN__ , __TMP__1 , __TMP__2 , __RCPPTYPE__ ) */ \\
        default: \\
            throw std::range_error( "not a vector" ) ; \\
        }

    #define RCPP_RETURN_VECTOR2( _FUN_, _SEXP_1, _SEXP_2 )  ___RCPP_RETURN___2( _FUN_, _SEXP_1, _SEXP_2, Vector )
    #define RCPP_RETURN_MATRIX2( _FUN_, _SEXP_1, _SEXP_2 )  ___RCPP_RETURN___2( _FUN_, _SEXP_1, _SEXP_2, Matrix )

    template<typename T> IntegerVector cummatch_impl(T small, T big ) {
        int smalllen = LENGTH(small);
        IntegerVector res(smalllen,NA_INTEGER);
        int cur = 0;
        int biglen = LENGTH(big);
        for (int si = 0; si < smalllen; ++si) {
            int rescur = NA_INTEGER;
            for (int bi = cur; bi < biglen; ++bi) {
                if (small(si) == big(bi)) {
                    rescur = bi;
                    break;
                }
            }
            if (rescur == NA_INTEGER) break;
            res(si) = rescur+1;
            cur = rescur+1;
        }
        return res;
    }

    // [[Rcpp::export]]
    IntegerVector cummatch(SEXP small, SEXP big ) { RCPP_RETURN_VECTOR2(cummatch_impl,small,big); }

');