flatten.cpp

// [[Rcpp::plugins("cpp11")]]

#include <Rcpp.h>
using namespace Rcpp;

void append_string(std::vector<std::string>& s1, const std::string s2) {
    if (!s2.empty()) {
        std::transform(s1.begin(), s1.end(), s1.begin(),
                       [&] (std::string& s) { return s2 + '.' + s; });
    }
}

void append_list(List& x, const List& other) {
    size_t n = other.size();
    std::vector<std::string> names = other.names();
    for (size_t i = 0; i < n; ++i)
        x.push_back(other[i], names[i]);
}

// [[Rcpp::export]]
List flatten(const List & x, std::string name = "") {
    size_t n = x.size();
    std::vector<std::string> names = x.names();
    append_string(names, name);
    List res;
    for (size_t i = 0; i < n; ++i) {
        if (is<List>(x[i]))
            append_list(res, flatten(x[i], names[i]));
        else
            res.push_back(x[i], names[i]);
    }
    return res;
}


/*** R
l <- list(a = 1:5,
          b = list(c = 1:10,
                   b = letters,
                   f = list(b = letters,
                            c = 1:10)),
          c = letters,
          d = list(a = 1))
flatten(l)
*/

unlist.cpp

// [[Rcpp::plugins("cpp11")]]

#include <Rcpp.h>
using namespace Rcpp;

SEXPTYPE sexp_type(const List& x) {
    SEXPTYPE RTYPE = 0;
    size_t n = x.size();
    for (size_t i = 0; i < n; ++i) {
        if (Rf_length(x[i]) == 0)
            continue;
        SEXPTYPE ETYPE = TYPEOF(x[i]);
        // See https://cran.r-project.org/doc/manuals/r-release/R-ints.html#SEXPTYPEs
        if (ETYPE < LGLSXP || ETYPE > STRSXP)
            stop("Unsupported '%s' type.", Rf_type2str(ETYPE));
        RTYPE = std::max(ETYPE, RTYPE);
    }
    return RTYPE;
}

template <int RTYPE, typename type = typename Vector<RTYPE>::elem_type>
Vector<RTYPE> list2vec(const List& x, bool use_names) {
    size_t n = x.size();
    type NA = Vector<RTYPE>::get_na();
    Vector<RTYPE> res = no_init(n);
    for (size_t i = 0; i < n; ++i) {
        if (Rf_length(x[i]) > 1)
            stop("Length of the elements must 0 or 1.");
        res[i] = Rf_length(x[i]) == 0 ? NA : as<type>(x[i]);
    }
    if (use_names && !Rf_isNull(x.names()))
        res.names() = x.names();
    return res;
}

// [[Rcpp::export]]
SEXP collapsed_list(const List& x, bool use_names = true) {
    if (x.size() == 0) return R_NilValue;
    SEXPTYPE res_type = sexp_type(x);
    switch(res_type) {
    case LGLSXP: return list2vec<LGLSXP>(x, use_names);
    case INTSXP: return list2vec<INTSXP>(x, use_names);
    case REALSXP: return list2vec<REALSXP>(x, use_names);
    case CPLXSXP: return list2vec<CPLXSXP>(x, use_names);
    case STRSXP: return list2vec<STRSXP, String>(x, use_names);
    default: return R_NilValue;
    }
}

/*** R
collapsed_list(list(NULL, list(), list(), TRUE))
collapsed_list(list(NULL, list(), list(), 1L))
collapsed_list(list(NULL, list(), list(), 1.0))
collapsed_list(list(NULL, list(), list(), as.complex(1)))
collapsed_list(list(NULL, list(), list(), "dfsda"))
*/