void omxExpectation::loadFromR()
{
if (!rObj || !data) return;
auto ox = this;
int numCols=0;
bool isRaw = strEQ(omxDataType(data), "raw");
if (isRaw || data->hasSummaryStats()) {
ProtectedSEXP Rdcn(R_do_slot(rObj, Rf_install("dataColumnNames")));
loadCharVecFromR(name, Rdcn, dataColumnNames);
ProtectedSEXP Rdc(R_do_slot(rObj, Rf_install("dataColumns")));
numCols = Rf_length(Rdc);
ox->saveDataColumnsInfo(Rdc);
if(OMX_DEBUG) mxPrintMat("Variable mapping", base::getDataColumns());
if (isRaw) {
auto dc = base::getDataColumns();
for (int cx=0; cx < numCols; ++cx) {
int var = dc[cx];
data->assertColumnIsData(var);
}
}
}
if (R_has_slot(rObj, Rf_install("thresholds"))) {
if(OMX_DEBUG) {
mxLog("Accessing Threshold matrix.");
}
ProtectedSEXP threshMatrix(R_do_slot(rObj, Rf_install("thresholds")));
if(INTEGER(threshMatrix)[0] != NA_INTEGER) {
ox->thresholdsMat = omxMatrixLookupFromState1(threshMatrix, ox->currentState);
ox->loadThresholds();
} else {
if (OMX_DEBUG) {
mxLog("No thresholds matrix; not processing thresholds.");
}
ox->numOrdinal = 0;
}
}
}
SEXP R_hasSlot(SEXP obj, SEXP name)
{
return ScalarLogical(R_has_slot(obj, name));
}
static void omxExpectationProcessDataStructures(omxExpectation* ox, SEXP rObj)
{
int index, numCols, numOrdinal=0;
SEXP nextMatrix, itemList, threshMatrix;
if(rObj == NULL) return;
if(OMX_DEBUG) {
mxLog("Accessing variable mapping structure.");
}
if (R_has_slot(rObj, Rf_install("dataColumns"))) {
{ScopedProtect p1(nextMatrix, R_do_slot(rObj, Rf_install("dataColumns")));
ox->dataColumns = omxNewMatrixFromRPrimitive(nextMatrix, ox->currentState, 0, 0);
}
if(OMX_DEBUG) {
omxPrint(ox->dataColumns, "Variable mapping");
}
numCols = ox->dataColumns->cols;
if (R_has_slot(rObj, Rf_install("thresholds"))) {
if(OMX_DEBUG) {
mxLog("Accessing Threshold matrix.");
}
ScopedProtect p1(threshMatrix, R_do_slot(rObj, Rf_install("thresholds")));
if(INTEGER(threshMatrix)[0] != NA_INTEGER) {
if(OMX_DEBUG) {
mxLog("Accessing Threshold Mappings.");
}
/* Process the data and threshold mapping structures */
/* if (threshMatrix == NA_INTEGER), then we could ignore the slot "thresholdColumns"
* and fill all the thresholds with {NULL, 0, 0}.
* However the current path does not have a lot of overhead. */
int* thresholdColumn, *thresholdNumber;
{ScopedProtect pc(nextMatrix, R_do_slot(rObj, Rf_install("thresholdColumns")));
thresholdColumn = INTEGER(nextMatrix);
}
{ScopedProtect pi(itemList, R_do_slot(rObj, Rf_install("thresholdLevels")));
thresholdNumber = INTEGER(itemList);
}
ox->thresholds.reserve(numCols);
for(index = 0; index < numCols; index++) {
if(thresholdColumn[index] == NA_INTEGER) { // Continuous variable
if(OMX_DEBUG) {
mxLog("Column %d is continuous.", index);
}
omxThresholdColumn col;
ox->thresholds.push_back(col);
} else {
omxThresholdColumn col;
col.matrix = omxMatrixLookupFromState1(threshMatrix, ox->currentState);
col.column = thresholdColumn[index];
col.numThresholds = thresholdNumber[index];
ox->thresholds.push_back(col);
if(OMX_DEBUG) {
mxLog("Column %d is ordinal with %d thresholds in threshold column %d.",
index, thresholdNumber[index], thresholdColumn[index]);
}
numOrdinal++;
}
}
if(OMX_DEBUG) {
mxLog("%d threshold columns processed.", numOrdinal);
}
ox->numOrdinal = numOrdinal;
} else {
if (OMX_DEBUG) {
mxLog("No thresholds matrix; not processing thresholds.");
}
ox->numOrdinal = 0;
}
}
}
}
static PyObject*
Sexp_do_slot(PyObject *self, PyObject *name)
{
SEXP sexp = RPY_SEXP(((PySexpObject*)self));
if (! sexp) {
PyErr_Format(PyExc_ValueError, "NULL SEXP.");
return NULL;
}
#if (PY_VERSION_HEX < 0x03010000)
if (! PyString_Check(name)) {
#else
if (! PyUnicode_Check(name)) {
#endif
PyErr_SetString(PyExc_TypeError, "The name must be a string.");
return NULL;
}
#if (PY_VERSION_HEX < 0x03010000)
char *name_str = PyString_AS_STRING(name);
#else
PyObject *pybytes = PyUnicode_AsLatin1String(name);
char *name_str = PyBytes_AsString(pybytes);
#endif
if (! R_has_slot(sexp, install(name_str))) {
PyErr_SetString(PyExc_LookupError, "The object has no such attribute.");
#if (PY_VERSION_HEX >= 0x03010000)
Py_DECREF(pybytes);
#endif
return NULL;
}
SEXP res_R = GET_SLOT(sexp, install(name_str));
#if (PY_VERSION_HEX >= 0x03010000)
Py_DECREF(pybytes);
#endif
PyObject *res = (PyObject *)newPySexpObject(res_R, 1);
return res;
}
PyDoc_STRVAR(Sexp_do_slot_doc,
"Returns the attribute/slot for an R object.\n"
" The name of the slot (a string) is the only parameter for\n"
"the method.\n"
":param name: string\n"
":rtype: instance of type or subtype :class:`rpy2.rinterface.Sexp`");
static PyObject*
Sexp_do_slot_assign(PyObject *self, PyObject *args)
{
SEXP sexp = RPY_SEXP(((PySexpObject*)self));
if (! sexp) {
PyErr_Format(PyExc_ValueError, "NULL SEXP.");
return NULL;;
}
char *name_str;
PyObject *value;
if (! PyArg_ParseTuple(args, "sO",
&name_str,
&value)) {
return NULL;
}
if (! PyObject_IsInstance(value,
(PyObject*)&Sexp_Type)) {
PyErr_Format(PyExc_ValueError, "Value must be an instance of Sexp.");
return NULL;
}
SEXP value_sexp = RPY_SEXP((PySexpObject *)value);
if (! value_sexp) {
PyErr_Format(PyExc_ValueError, "NULL SEXP.");
return NULL;;
}
SET_SLOT(sexp, install(name_str), value_sexp);
Py_INCREF(Py_None);
return Py_None;
}
void omxLISRELExpectation::init() {
if(OMX_DEBUG) { mxLog("Initializing LISREL Expectation."); }
slope = 0;
verbose = 0;
if (R_has_slot(rObj, Rf_install("verbose"))) {
ProtectedSEXP Rverbose(R_do_slot(rObj, Rf_install("verbose")));
verbose = Rf_asInteger(Rverbose);
}
int nx, nxi, ny, neta, ntotal;
SEXP slotValue;
/* Create and fill expectation */
omxLISRELExpectation *LISobj = this;
/* Set up expectation structures */
if(OMX_DEBUG) { mxLog("Initializing LISREL Meta Data for expectation."); }
if(OMX_DEBUG) { mxLog("Processing LX."); }
LISobj->LX = omxNewMatrixFromSlot(rObj, currentState, "LX");
if(OMX_DEBUG) { mxLog("Processing LY."); }
LISobj->LY = omxNewMatrixFromSlot(rObj, currentState, "LY");
if(OMX_DEBUG) { mxLog("Processing BE."); }
LISobj->BE = omxNewMatrixFromSlot(rObj, currentState, "BE");
if(OMX_DEBUG) { mxLog("Processing GA."); }
LISobj->GA = omxNewMatrixFromSlot(rObj, currentState, "GA");
if(OMX_DEBUG) { mxLog("Processing PH."); }
LISobj->PH = omxNewMatrixFromSlot(rObj, currentState, "PH");
if(OMX_DEBUG) { mxLog("Processing PS."); }
LISobj->PS = omxNewMatrixFromSlot(rObj, currentState, "PS");
if(OMX_DEBUG) { mxLog("Processing TD."); }
LISobj->TD = omxNewMatrixFromSlot(rObj, currentState, "TD");
if(OMX_DEBUG) { mxLog("Processing TE."); }
LISobj->TE = omxNewMatrixFromSlot(rObj, currentState, "TE");
if(OMX_DEBUG) { mxLog("Processing TH."); }
LISobj->TH = omxNewMatrixFromSlot(rObj, currentState, "TH");
if(OMX_DEBUG) { mxLog("Processing TX."); }
LISobj->TX = omxNewMatrixFromSlot(rObj, currentState, "TX");
if(OMX_DEBUG) { mxLog("Processing TY."); }
LISobj->TY = omxNewMatrixFromSlot(rObj, currentState, "TY");
if(OMX_DEBUG) { mxLog("Processing KA."); }
LISobj->KA = omxNewMatrixFromSlot(rObj, currentState, "KA");
if(OMX_DEBUG) { mxLog("Processing AL."); }
LISobj->AL = omxNewMatrixFromSlot(rObj, currentState, "AL");
LISobj->noLY = LISobj->LY == NULL;
if(LISobj->noLY) {
LISobj->LY = omxInitMatrix(0, 0, TRUE, currentState);
LISobj->PS = omxInitMatrix(0, 0, TRUE, currentState);
LISobj->BE = omxInitMatrix(0, 0, TRUE, currentState);
LISobj->TE = omxInitMatrix(0, 0, TRUE, currentState);
}
LISobj->noLX = LISobj->LX == NULL;
if(LISobj->noLX) {
LISobj->LX = omxInitMatrix(0, 0, TRUE, currentState);
LISobj->PH = omxInitMatrix(0, 0, TRUE, currentState);
LISobj->TD = omxInitMatrix(0, 0, TRUE, currentState);
}
LISobj->Lnocol = LISobj->LY->cols == 0 || LISobj->LX->cols == 0;
if(LISobj->Lnocol) {
LISobj->GA = omxInitMatrix(LISobj->LY->cols, LISobj->LX->cols, TRUE, currentState);
LISobj->TH = omxInitMatrix(LISobj->LX->rows, LISobj->LY->rows, TRUE, currentState);
}
/* Identity Matrix, Size Of BE */
if(OMX_DEBUG) { mxLog("Generating I."); }
LISobj->I = omxNewIdentityMatrix(LISobj->BE->rows, currentState);
/* Get the nilpotency index of the BE matrix for I-BE inverse speedup */
if(OMX_DEBUG) { mxLog("Processing expansion iteration depth."); }
{ScopedProtect p1(slotValue, R_do_slot(rObj, Rf_install("depth")));
LISobj->numIters = INTEGER(slotValue)[0];
if(OMX_DEBUG) { mxLog("Using %d iterations.", LISobj->numIters); }
}
/* Initialize the place holder matrices used in calculations */
nx = LISobj->LX->rows;
nxi = LISobj->LX->cols;
ny = LISobj->LY->rows;
neta = LISobj->LY->cols;
ntotal = nx + ny;
if(OMX_DEBUG) { mxLog("Generating internals for computation."); }
LISobj->A = omxInitMatrix(nx, nxi, TRUE, currentState);
LISobj->B = omxInitMatrix(nx, nx, TRUE, currentState);
LISobj->C = omxInitMatrix(neta, neta, TRUE, currentState);
LISobj->D = omxInitMatrix(ny, neta, TRUE, currentState);
LISobj->E = omxInitMatrix(nx, neta, TRUE, currentState);
LISobj->F = omxInitMatrix(nx, ny, TRUE, currentState);
LISobj->G = omxInitMatrix(neta, nxi, TRUE, currentState);
LISobj->H = omxInitMatrix(ny, neta, TRUE, currentState);
LISobj->J = omxInitMatrix(ny, ny, TRUE, currentState);
LISobj->K = omxInitMatrix(neta, 1, TRUE, currentState);
LISobj->L = omxInitMatrix(neta, neta, TRUE, currentState);
LISobj->TOP = omxInitMatrix(ny, ntotal, TRUE, currentState);
LISobj->BOT = omxInitMatrix(nx, ntotal, TRUE, currentState);
LISobj->MUX = omxInitMatrix(nx, 1, TRUE, currentState);
LISobj->MUY = omxInitMatrix(ny, 1, TRUE, currentState);
LISobj->cov = omxInitMatrix(ntotal, ntotal, TRUE, currentState);
LISobj->args = (omxMatrix**) R_alloc(2, sizeof(omxMatrix*));
/* Means */
if(LISobj->TX != NULL || LISobj->TY != NULL || LISobj->KA != NULL || LISobj->AL != NULL) {
LISobj->means = omxInitMatrix(1, ntotal, TRUE, currentState);
} else LISobj->means = NULL;
//TODO: Adjust means processing to allow only Xs or only Ys
}
