2015-08-02 2 views
2

Я ищу, чтобы заставить один dataframe, чтобы соответствовать структуре другого, в соответствии с определенными критериямиг - заставить один кадр данных в структуре другого

Пример данных

## 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: до т O 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 

Я не уверен, что лучший способ делать это; на данный момент я рассматриваю возможность использования регулярных выражений для каждой строки, нахождение всех «десятичных» nubmers перед «целыми числами», затем все целые числа, затем все «десятичные знаки» после целых чисел, но на данный момент это кажется слишком сложным, Я надеюсь, что есть более простой метод, который я забыл?

+0

Откуда вы знаете, какие столбцы отсутствуют? Например, если между столбцом не существует целочисленного столбца, как вы их назначаете? Кроме того, вы не задавали 'l',' m', 'n' как целые столбцы. Ни 'col3', как целочисленный столбец. Это должно быть 'col3 = c (NA_integer_, 2L, 3L)' –

+0

@DavidArenburg фиксировал целые числа. Между числовыми десятичными столбцами всегда будет хотя бы один целочисленный столбец (но, возможно, с 'NA'). – tospig

ответ

2

Это решение полагается только на то, что 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 
1

На мой взгляд, это наиболее целесообразно предварительно выделить df_final НСБУ, а затем индекс-назначения столбцы из df_data. Единственный трюк - это определение того, какие столбцы нужно назначить.

Я вижу, что вы хотите правильно-обосновать (так сказать) столбцы в наборах столбцов. Таким образом, требование сводится к тому, что я бы назвал «кумулятивным соответствием» типов обращенных столбцов df_data в типах обращенных столбцов df_final.Другими словами, вам необходимо перейти от права налево через типы столбцов 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-уровня и вызов функции (например, повторные вызовы match() на подвекторах big). В последнее время я играл с Rcpp, поэтому решил попробовать записать более эффективную версию в Rcpp. Я ссылался на how can I handle vectors without knowing the type in Rcpp, чтобы попытаться выяснить, как написать вектор-тип-агностическую функцию, а решение немного хаки, с использованием функции шаблона C++ с функцией обертки, которая switch es на векторе, и, следовательно, должна в основном создайте отдельный вызов функции для каждого 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); } 

'); 
+0

Я ценю мысль и усилие, вложенные в этот ответ! – tospig

Смежные вопросы