static SEXP convert_array_data_frame()

in r/src/convert_array.c [113:175]

• 52 lines of code
• 9 McCabe index (conditional complexity)

static SEXP convert_array_data_frame(SEXP array_xptr, SEXP ptype_sexp) {
  // If array_xptr is a union, use default convert behaviour
  struct ArrowSchema* schema = schema_from_array_xptr(array_xptr);
  struct ArrowSchemaView schema_view;
  if (ArrowSchemaViewInit(&schema_view, schema, NULL) != NANOARROW_OK) {
    Rf_error("Invalid schema");
  }

  if (schema_view.storage_type != NANOARROW_TYPE_STRUCT) {
    ptype_sexp = PROTECT(nanoarrow_c_infer_ptype(array_xptr_get_schema(array_xptr)));
    SEXP default_result =
        convert_array_default(array_xptr, VECTOR_TYPE_DATA_FRAME, ptype_sexp);
    UNPROTECT(1);
    return default_result;
  }

  struct ArrowArray* array = array_from_xptr(array_xptr);
  R_xlen_t n_col = array->n_children;
  SEXP result = PROTECT(Rf_allocVector(VECSXP, n_col));

  if (ptype_sexp == R_NilValue) {
    SEXP result_names = PROTECT(Rf_allocVector(STRSXP, n_col));

    for (R_xlen_t i = 0; i < n_col; i++) {
      SEXP child_xptr = PROTECT(borrow_array_child_xptr(array_xptr, i));
      SET_VECTOR_ELT(result, i, nanoarrow_c_convert_array(child_xptr, R_NilValue));
      UNPROTECT(1);

      struct ArrowSchema* schema = schema_from_array_xptr(child_xptr);
      if (schema->name != NULL) {
        SET_STRING_ELT(result_names, i, Rf_mkCharCE(schema->name, CE_UTF8));
      } else {
        SET_STRING_ELT(result_names, i, Rf_mkChar(""));
      }
    }

    Rf_setAttrib(result, R_NamesSymbol, result_names);
    Rf_setAttrib(result, R_ClassSymbol, nanoarrow_cls_data_frame);
    UNPROTECT(1);
  } else {
    if (n_col != Rf_xlength(ptype_sexp)) {
      Rf_error("Expected data.frame() ptype with %ld column(s) but found %ld column(s)",
               (long)n_col, (long)Rf_xlength(ptype_sexp));
    }

    for (R_xlen_t i = 0; i < n_col; i++) {
      SEXP child_xptr = PROTECT(borrow_array_child_xptr(array_xptr, i));
      SEXP child_ptype = VECTOR_ELT(ptype_sexp, i);
      SET_VECTOR_ELT(result, i, nanoarrow_c_convert_array(child_xptr, child_ptype));
      UNPROTECT(1);
    }

    Rf_setAttrib(result, R_NamesSymbol, Rf_getAttrib(ptype_sexp, R_NamesSymbol));
    Rf_copyMostAttrib(ptype_sexp, result);
  }

  if (Rf_inherits(result, "data.frame")) {
    nanoarrow_set_rownames(result, array->length);
  }

  UNPROTECT(1);
  return result;
}