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有三套＆＃39;列：

set1：最多3列将是一个＆＃39;十进制数＆＃39; （最左边的栏目）
set2：最多3列是整数
set3：最多3列将是＆＃39;十进制数＆＃39; （最右边的栏目）

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

我需要适应＆＃39; df_data df_final根据规则：

列a, b, c将包含＆＃39;十进制数字＆＃39;来自set1
列l, m, n只有set2
列x, y, z将包含＆＃39;十进制数字＆＃39;来自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

我不确定这样做的最佳方法;目前我正考虑在每一行使用正则表达式，找到所有“十进制”字样。在整数之前的nubmers，然后是所有的整数，然后是所有的小数＆＃39;在整数之后，但目前这看起来过于复杂，我希望有一种我更容易忽视的方法吗？

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

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

我看到你想对列集中的列进行右对齐（可以这么说）。因此，该要求相当于我所描述的＆＃34;累积匹配＆＃34; df_data的反向列类型中df_final的反转列类型。换句话说，您需要从右向左进行df_data和df_final的列类型，并找到下一个（从右向）匹配。

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

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

从性能角度来看，考虑到所有R级循环和函数调用（例如cummatch()的子向量上match()的重复调用），我的big函数可能很糟糕。我最近一直在玩Rcpp，于是决定尝试在Rcpp中编写更高性能的版本。我提到how can I handle vectors without knowing the type in Rcpp试图弄清楚如何编写一个向量类型不可知的函数，并且该解决方案有点hacky，涉及一个C ++模板函数，其函数包含switch。 TYPEOF()向量，因此必须基本上为case内的每个switch实例化一个单独的函数调用。我的函数有两个向量参数，所以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); }

');

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

2 个答案: