char *nvimcom_browser_line(SEXP *x, const char *xname, const char *curenv, const char *prefix, char *p) { char xclass[64]; char newenv[512]; char curenvB[512]; char ebuf[64]; char pre[128]; char newpre[128]; int len; const char *ename; SEXP listNames, label, lablab, eexp, elmt = R_NilValue; SEXP cmdSexp, cmdexpr, ans, cmdSexp2, cmdexpr2; ParseStatus status, status2; int er = 0; char buf[128]; if(strlen(xname) > 64) return p; if(obbrbufzise < strlen(obbrbuf2) + 1024) p = nvimcom_grow_obbrbuf(); p = nvimcom_strcat(p, prefix); if(Rf_isLogical(*x)){ p = nvimcom_strcat(p, "%#"); strcpy(xclass, "logical"); } else if(Rf_isNumeric(*x)){ p = nvimcom_strcat(p, "{#"); strcpy(xclass, "numeric"); } else if(Rf_isFactor(*x)){ p = nvimcom_strcat(p, "'#"); strcpy(xclass, "factor"); } else if(Rf_isValidString(*x)){ p = nvimcom_strcat(p, "\"#"); strcpy(xclass, "character"); } else if(Rf_isFunction(*x)){ p = nvimcom_strcat(p, "(#"); strcpy(xclass, "function"); } else if(Rf_isFrame(*x)){ p = nvimcom_strcat(p, "[#"); strcpy(xclass, "data.frame"); } else if(Rf_isNewList(*x)){ p = nvimcom_strcat(p, "[#"); strcpy(xclass, "list"); } else if(Rf_isS4(*x)){ p = nvimcom_strcat(p, "<#"); strcpy(xclass, "s4"); } else if(TYPEOF(*x) == PROMSXP){ p = nvimcom_strcat(p, "&#"); strcpy(xclass, "lazy"); } else { p = nvimcom_strcat(p, "=#"); strcpy(xclass, "other"); } PROTECT(lablab = allocVector(STRSXP, 1)); SET_STRING_ELT(lablab, 0, mkChar("label")); PROTECT(label = getAttrib(*x, lablab)); p = nvimcom_strcat(p, xname); p = nvimcom_strcat(p, "\t"); if(length(label) > 0){ if(Rf_isValidString(label)){ snprintf(buf, 127, "%s", CHAR(STRING_ELT(label, 0))); p = nvimcom_strcat(p, buf); } else { if(labelerr) p = nvimcom_strcat(p, "Error: label isn't \"character\"."); } } p = nvimcom_strcat(p, "\n"); UNPROTECT(2); if(strcmp(xclass, "list") == 0 || strcmp(xclass, "data.frame") == 0 || strcmp(xclass, "s4") == 0){ strncpy(curenvB, curenv, 500); if(xname[0] == '[' && xname[1] == '['){ curenvB[strlen(curenvB) - 1] = 0; } if(strcmp(xclass, "s4") == 0) snprintf(newenv, 500, "%s%s@", curenvB, xname); else snprintf(newenv, 500, "%s%s$", curenvB, xname); if((nvimcom_get_list_status(newenv, xclass) == 1)){ len = strlen(prefix); if(nvimcom_is_utf8){ int j = 0, i = 0; while(i < len){ if(prefix[i] == '\xe2'){ i += 3; if(prefix[i-1] == '\x80' || prefix[i-1] == '\x94'){ pre[j] = ' '; j++; } else { pre[j] = '\xe2'; j++; pre[j] = '\x94'; j++; pre[j] = '\x82'; j++; } } else { pre[j] = prefix[i]; i++, j++; } } pre[j] = 0; } else { for(int i = 0; i < len; i++){ if(prefix[i] == '-' || prefix[i] == '`') pre[i] = ' '; else pre[i] = prefix[i]; } pre[len] = 0; } sprintf(newpre, "%s%s", pre, strT); if(strcmp(xclass, "s4") == 0){ snprintf(buf, 127, "slotNames(%s%s)", curenvB, xname); PROTECT(cmdSexp = allocVector(STRSXP, 1)); SET_STRING_ELT(cmdSexp, 0, mkChar(buf)); PROTECT(cmdexpr = R_ParseVector(cmdSexp, -1, &status, R_NilValue)); if (status != PARSE_OK) { p = nvimcom_strcat(p, "nvimcom error: invalid value in slotNames("); p = nvimcom_strcat(p, xname); p = nvimcom_strcat(p, ")\n"); } else { PROTECT(ans = R_tryEval(VECTOR_ELT(cmdexpr, 0), R_GlobalEnv, &er)); if(er){ p = nvimcom_strcat(p, "nvimcom error: "); p = nvimcom_strcat(p, xname); p = nvimcom_strcat(p, "\n"); } else { len = length(ans); if(len > 0){ int len1 = len - 1; for(int i = 0; i < len; i++){ ename = CHAR(STRING_ELT(ans, i)); snprintf(buf, 127, "%s%s@%s", curenvB, xname, ename); PROTECT(cmdSexp2 = allocVector(STRSXP, 1)); SET_STRING_ELT(cmdSexp2, 0, mkChar(buf)); PROTECT(cmdexpr2 = R_ParseVector(cmdSexp2, -1, &status2, R_NilValue)); if (status2 != PARSE_OK) { p = nvimcom_strcat(p, "nvimcom error: invalid code \""); p = nvimcom_strcat(p, xname); p = nvimcom_strcat(p, "@"); p = nvimcom_strcat(p, ename); p = nvimcom_strcat(p, "\"\n"); } else { PROTECT(elmt = R_tryEval(VECTOR_ELT(cmdexpr2, 0), R_GlobalEnv, &er)); if(i == len1) sprintf(newpre, "%s%s", pre, strL); p = nvimcom_browser_line(&elmt, ename, newenv, newpre, p); UNPROTECT(1); } UNPROTECT(2); } } } UNPROTECT(1); } UNPROTECT(2); } else { PROTECT(listNames = getAttrib(*x, R_NamesSymbol)); len = length(listNames); if(len == 0){ /* Empty list? */ int len1 = length(*x); if(len1 > 0){ /* List without names */ len1 -= 1; for(int i = 0; i < len1; i++){ sprintf(ebuf, "[[%d]]", i + 1); elmt = VECTOR_ELT(*x, i); p = nvimcom_browser_line(&elmt, ebuf, newenv, newpre, p); } sprintf(newpre, "%s%s", pre, strL); sprintf(ebuf, "[[%d]]", len1 + 1); PROTECT(elmt = VECTOR_ELT(*x, len)); p = nvimcom_browser_line(&elmt, ebuf, newenv, newpre, p); UNPROTECT(1); } } else { /* Named list */ len -= 1; for(int i = 0; i < len; i++){ PROTECT(eexp = STRING_ELT(listNames, i)); ename = CHAR(eexp); UNPROTECT(1); if(ename[0] == 0){ sprintf(ebuf, "[[%d]]", i + 1); ename = ebuf; } PROTECT(elmt = VECTOR_ELT(*x, i)); p = nvimcom_browser_line(&elmt, ename, newenv, newpre, p); UNPROTECT(1); } sprintf(newpre, "%s%s", pre, strL); ename = CHAR(STRING_ELT(listNames, len)); if(ename[0] == 0){ sprintf(ebuf, "[[%d]]", len + 1); ename = ebuf; } PROTECT(elmt = VECTOR_ELT(*x, len)); p = nvimcom_browser_line(&elmt, ename, newenv, newpre, p); UNPROTECT(1); } UNPROTECT(1); /* listNames */ } } } return p; }
SEXP R_dataframe2dataset(SEXP dtaframe, SEXP path, SEXP shape_columns) { if (!Rf_isFrame(dtaframe)) return showError<false>(L"argument 0 is not a data.frame"), R_NilValue; //same as narray_tools.cpp std::wstring dataset_name; tools::copy_to(path, dataset_name); struct _cleanup { typedef std::vector<cols_base*> c_type; std::vector<std::string> name; c_type c; //std::vector<c_type::const_iterator> shape; c_type shape; ~_cleanup() { for (size_t i = 0; i < c.size(); i++) delete c[i]; for (size_t i = 0; i < shape.size(); i++) delete shape[i]; } }cols; //cols.name = df.attr("names"); tools::getNames(dtaframe, cols.name); if (cols.name.empty()) return showError<false>(L"data.frame has 0 column"), R_NilValue; if (tools::size(dtaframe) != cols.name.size()) return showError<false>(L"unknown"), R_NilValue; CComPtr<IGPUtilities> ipDEUtil; if (ipDEUtil.CoCreateInstance(CLSID_GPUtilities) != S_OK) return showError<true>(L"IDEUtilitiesImpl - CoCreateInstance has failed"), R_NilValue; HRESULT hr; //cols.c.resize(cols.name.size(), NULL); bool isShape = false; if (shape_columns != R_NilValue) { std::vector<std::string> shapes; tools::copy_to(shape_columns, shapes); if (shapes.size() < 2 || shapes.size() > 4) return showError<false>(L"shape expecting 2 strings"), NULL; isShape = true; for (size_t i = 0; i < shapes.size(); i++) { std::vector<std::string>::iterator it = std::find(cols.name.begin(), cols.name.end(), shapes[i]); if (it == cols.name.end()) return showError<false>(L"cannot find shape in data.frame"), NULL; size_t pos = std::distance(cols.name.begin(), it); cols.shape.push_back(new cols_wrap<double>(VECTOR_ELT(dtaframe, pos))); //cols.shape.[i] = cols.c.begin() + pos; it->clear(); } } CComPtr<IName> ipName; if (isShape) hr = ipDEUtil->CreateFeatureClassName(CComBSTR(dataset_name.c_str()), &ipName); else hr = ipDEUtil->CreateTableName(CComBSTR(dataset_name.c_str()), &ipName); CComQIPtr<IDatasetName> ipDatasetName(ipName); CComPtr<IWorkspaceName> ipWksName; CComQIPtr<IWorkspace> ipWks; if (hr == S_OK) hr = ipDatasetName->get_WorkspaceName(&ipWksName); if (hr == S_OK) { CComPtr<IUnknown> ipUnk; hr = CComQIPtr<IName>(ipWksName)->Open(&ipUnk); ipWks = ipUnk; } if (hr != S_OK) return showError<true>(L"invalid table name"), R_NilValue; CComQIPtr<IFeatureWorkspace> ipFWKS(ipWks); ATLASSERT(ipFWKS); if (!ipFWKS) return showError<true>(L"not a FeatureWorkspace"), R_NilValue; CComBSTR bstrTableName; ipDatasetName->get_Name(&bstrTableName); /* CComQIPtr<IWorkspaceSchemaImpl> ipWSchema(ipWks); if (ipWSchema) { VARIANT_BOOL b = VARIANT_FALSE; ipWSchema->TableExists(bstrTableName, &b); if (b != VARIANT_FALSE) return ::Rf_error("table Exists"), NULL; }*/ CComPtr<IFieldsEdit> ipFields; hr = ipFields.CoCreateInstance(CLSID_Fields); if (hr != S_OK) return showError<true>(L"CoCreateInstance"), R_NilValue; //if (!createField(NULL, esriFieldTypeOID, ipFields)) // return NULL; if (isShape) { long pos = createField(NULL, esriFieldTypeGeometry, ipFields); CComPtr<IGeometryDef> ipGeoDef; CComPtr<IField> ipField; ipFields->get_Field(pos, &ipField); ipField->get_GeometryDef(&ipGeoDef); CComQIPtr<IGeometryDefEdit> ipGeoDefEd(ipGeoDef); ipGeoDefEd->put_GeometryType(esriGeometryPoint); CComQIPtr<ISpatialReference> ipSR(g_lastUsedSR); if (!ipSR) { ipSR.CoCreateInstance(CLSID_UnknownCoordinateSystem); CComQIPtr<ISpatialReferenceResolution> ipSRR(ipSR); if (ipSRR) FIX_DEFAULT_SR(ipSRR); } ipGeoDefEd->putref_SpatialReference(ipSR); } for (size_t i = 0; i < cols.name.size(); i++) { if (cols.name[i].empty()) continue; const char* str = cols.name[i].c_str(); cols_base* item = NULL; SEXP it = VECTOR_ELT(dtaframe, i); switch (TYPEOF(it)) { case NILSXP: case SYMSXP: case RAWSXP: case LISTSXP: case CLOSXP: case ENVSXP: case PROMSXP: case LANGSXP: case SPECIALSXP: case BUILTINSXP: case CPLXSXP: case DOTSXP: case ANYSXP: case VECSXP: case EXPRSXP: case BCODESXP: case EXTPTRSXP: case WEAKREFSXP: case S4SXP: default: return showError<false>(L"unsupported datat.field column type"), NULL; case INTSXP: item = new cols_wrap<int>(it); item->pos = createField(str, esriFieldTypeInteger, ipFields); break; case REALSXP: item = new cols_wrap<double>(it); item->pos = createField(str, esriFieldTypeDouble, ipFields); break; case STRSXP: case CHARSXP: item = new cols_wrap<std::string>(it); item->pos = createField(str, esriFieldTypeString, ipFields); break; case LGLSXP: item = new cols_wrap<bool>(it); item->pos = createField(str, esriFieldTypeInteger, ipFields); break; } ATLASSERT(item); cols.c.push_back(item); item->name_ref = &cols.name[i]; } CComPtr<IFieldChecker> ipFieldChecker; ipFieldChecker.CoCreateInstance(CLSID_FieldChecker); if (ipFieldChecker) { ipFieldChecker->putref_ValidateWorkspace(ipWks); long error = 0; //fix fields names CComPtr<IFields> ipFixedFields; CComPtr<IEnumFieldError> ipEError; hr = ipFieldChecker->Validate(ipFields, &ipEError, &ipFixedFields); if (hr != S_OK) return showError<true>(L"validate fields failed"), NULL; if (ipFixedFields) { ipFields = ipFixedFields; for (size_t c = 0; c < cols.c.size(); c++) { CComPtr<IField> ipFixedField; ipFixedFields->get_Field(cols.c[c]->pos, &ipFixedField); _bstr_t name; ipFixedField->get_Name(name.GetAddress()); cols.c[c]->name_ref->assign(name); } } } CComPtr<IUID> ipUID; ipUID.CoCreateInstance(CLSID_UID); CComQIPtr<ITable> ipTableNew; CComBSTR keyword(L""); hr = E_FAIL; if (isShape) { if (ipUID) { OLECHAR buf[256]; ::StringFromGUID2(CLSID_Feature, buf, 256); ipUID->put_Value(CComVariant(buf)); } CComPtr<IFeatureClass> ipFClass; hr = ipFWKS->CreateFeatureClass(bstrTableName, ipFields, ipUID, 0, esriFTSimple, CComBSTR(L"Shape"), keyword, &ipFClass); ipTableNew = ipFClass; } else { if (ipUID) { OLECHAR buf[256]; ::StringFromGUID2(CLSID_Row, buf, 256); ipUID->put_Value(CComVariant(buf)); } hr = ipFWKS->CreateTable(bstrTableName, ipFields, ipUID, 0, keyword, &ipTableNew); } if (hr != S_OK) return showError<true>(L"validate fields failed"), R_NilValue; CComVariant oid; CComPtr<ICursor> ipCursor; CComPtr<IRowBuffer> ipRowBuffer; hr = ipTableNew->Insert(VARIANT_TRUE, &ipCursor); if (hr != S_OK) return showError<true>(L"Insert cursor failed"), R_NilValue; hr = ipTableNew->CreateRowBuffer(&ipRowBuffer); if (hr != S_OK) return showError<true>(L"Insert cursor failed"), R_NilValue; //re-map fields for (size_t c = 0; c < cols.c.size(); c++) ipCursor->FindField(CComBSTR(cols.c[c]->name_ref->c_str()), &(cols.c[c]->pos)); R_len_t n = tools::size(VECTOR_ELT(dtaframe, 0)); for (R_len_t i = 0; i < n; i++) { //ATLTRACE("\n"); for (size_t c = 0; c < cols.c.size(); c++) { if (cols.c[c]->pos < 0) continue; CComVariant val; cols.c[c]->get(i, val); hr = ipRowBuffer->put_Value(cols.c[c]->pos, val); if (hr != S_OK) return showError<true>(L"insert row value failed"), R_NilValue; //ATLTRACE(" [%i]=%f",cols[c]->pos, (float)val.dblVal); } VARIANT oid; if (isShape) { CComQIPtr<IPoint> ipPoint; ipPoint.CoCreateInstance(CLSID_Point); CComVariant valX, valY; cols.shape[0]->get(i, valX); cols.shape[1]->get(i, valY); ipPoint->PutCoords(valX.dblVal, valY.dblVal); CComQIPtr<IFeatureBuffer> ipFBuffer(ipRowBuffer); ATLASSERT(ipFBuffer); hr = ipFBuffer->putref_Shape(ipPoint); if (hr != S_OK) return showError<true>(L"insert shape failed"), R_NilValue; } hr = ipCursor->InsertRow(ipRowBuffer, &oid); if (hr != S_OK) return showError<true>(L"insert row failed"), R_NilValue; } return R_NilValue; }