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;
}
