00001
00009 #include "party.h"
00010
00011 void C_init_node(SEXP node, int nobs, int ninputs, int nsurr, int q) {
00012
00013 SEXP nodeID, weights, criterion, primarysplit, surrogatesplits,
00014 terminal, prediction;
00015
00016 if (LENGTH(node) < NODE_LENGTH)
00017 error("node is not a list with at least %d elements", NODE_LENGTH);
00018
00019 SET_VECTOR_ELT(node, S3_NODEID, nodeID = allocVector(INTSXP, 1));
00020 if (nobs > 0)
00021 SET_VECTOR_ELT(node, S3_WEIGHTS, weights = allocVector(REALSXP, nobs));
00022 else
00023 SET_VECTOR_ELT(node, S3_WEIGHTS, R_NilValue);
00024 SET_VECTOR_ELT(node, S3_SUMWEIGHTS, allocVector(REALSXP, 1));
00025 SET_VECTOR_ELT(node, S3_CRITERION,
00026 criterion = allocVector(VECSXP, CRITERION_LENGTH));
00027
00028 SET_VECTOR_ELT(criterion, S3_STATISTICS, allocVector(REALSXP, ninputs));
00029
00030 SET_VECTOR_ELT(criterion, S3_iCRITERION, allocVector(REALSXP, ninputs));
00031
00032 SET_VECTOR_ELT(criterion, S3_MAXCRITERION, allocVector(REALSXP, 1));
00033 SET_VECTOR_ELT(node, S3_TERMINAL, terminal = allocVector(LGLSXP, 1));
00034 INTEGER(terminal)[0] = 0;
00035 SET_VECTOR_ELT(node, S3_PSPLIT,
00036 primarysplit = allocVector(VECSXP, SPLIT_LENGTH));
00037 SET_VECTOR_ELT(node, S3_SSPLIT,
00038 surrogatesplits = allocVector(VECSXP, nsurr));
00039 SET_VECTOR_ELT(node, S3_PREDICTION, prediction = allocVector(REALSXP, q));
00040
00041 }
00042
00043 void S3set_nodeID(SEXP node, int nodeID) {
00044 INTEGER(VECTOR_ELT(node, S3_NODEID))[0] = nodeID;
00045 }
00046
00047 int S3get_nodeID(SEXP node) {
00048 return(INTEGER(VECTOR_ELT(node, S3_NODEID))[0]);
00049 }
00050
00051 SEXP S3get_nodeweights(SEXP node) {
00052 SEXP ans;
00053
00054 ans = VECTOR_ELT(node, S3_WEIGHTS);
00055 if (ans == R_NilValue)
00056 error("node has no weights element");
00057 return(VECTOR_ELT(node, S3_WEIGHTS));
00058 }
00059
00060 double S3get_sumweights(SEXP node) {
00061 REAL(VECTOR_ELT(node, S3_SUMWEIGHTS))[0];
00062 }
00063
00064 SEXP S3get_teststat(SEXP node) {
00065 return(VECTOR_ELT(VECTOR_ELT(node, S3_CRITERION), S3_STATISTICS));
00066 }
00067
00068 SEXP S3get_criterion(SEXP node) {
00069 return(VECTOR_ELT(VECTOR_ELT(node, S3_CRITERION), S3_iCRITERION));
00070 }
00071
00072 SEXP S3get_maxcriterion(SEXP node) {
00073 return(VECTOR_ELT(VECTOR_ELT(node, S3_CRITERION), S3_MAXCRITERION));
00074 }
00075
00076 void S3set_nodeterminal(SEXP node) {
00077 INTEGER(VECTOR_ELT(node, S3_TERMINAL))[0] = 1;
00078 }
00079
00080 int S3get_nodeterminal(SEXP node) {
00081 return(INTEGER(VECTOR_ELT(node, S3_TERMINAL))[0]);
00082 }
00083
00084 SEXP S3get_primarysplit(SEXP node) {
00085 return(VECTOR_ELT(node, S3_PSPLIT));
00086 }
00087
00088 SEXP S3get_surrogatesplits(SEXP node) {
00089 return(VECTOR_ELT(node, S3_SSPLIT));
00090 }
00091
00092 SEXP S3get_prediction(SEXP node) {
00093 return(VECTOR_ELT(node, S3_PREDICTION));
00094 }
00095
00096 SEXP S3get_leftnode(SEXP node) {
00097 return(VECTOR_ELT(node, S3_LEFT));
00098 }
00099
00100 SEXP S3get_rightnode(SEXP node) {
00101 return(VECTOR_ELT(node, S3_RIGHT));
00102 }
00103
00104 void C_init_orderedsplit(SEXP split, int nobs) {
00105
00106 SEXP variableID, splitpoint, splitstatistics, ordered, toleft;
00107
00108 if (LENGTH(split) < SPLIT_LENGTH)
00109 error("split is not a list with at least %d elements", SPLIT_LENGTH);
00110
00111 SET_VECTOR_ELT(split, S3_VARIABLEID,
00112 variableID = allocVector(INTSXP, 1));
00113 SET_VECTOR_ELT(split, S3_ORDERED,
00114 ordered = allocVector(LGLSXP, 1));
00115 INTEGER(ordered)[0] = 1;
00116 SET_VECTOR_ELT(split, S3_SPLITPOINT,
00117 splitpoint = allocVector(REALSXP, 1));
00118 if (nobs > 0)
00119 SET_VECTOR_ELT(split, S3_SPLITSTATISTICS,
00120 splitstatistics = allocVector(REALSXP, nobs));
00121 else
00122 SET_VECTOR_ELT(split, S3_SPLITSTATISTICS, R_NilValue);
00123 SET_VECTOR_ELT(split, S3_TOLEFT, toleft = allocVector(INTSXP, 1));
00124 INTEGER(toleft)[0] = 1;
00125 SET_VECTOR_ELT(split, S3_TABLE, R_NilValue);
00126 }
00127
00128 void C_init_nominalsplit(SEXP split, int nlevels, int nobs) {
00129
00130 SEXP variableID, splitpoint, splitstatistics, ordered, toleft, table;
00131
00132 if (LENGTH(split) < SPLIT_LENGTH)
00133 error("split is not a list with at least %d elements", SPLIT_LENGTH);
00134
00135 SET_VECTOR_ELT(split, S3_VARIABLEID, variableID = allocVector(INTSXP, 1));
00136 SET_VECTOR_ELT(split, S3_ORDERED, ordered = allocVector(LGLSXP, 1));
00137 INTEGER(ordered)[0] = 0;
00138 SET_VECTOR_ELT(split, S3_SPLITPOINT,
00139 splitpoint = allocVector(INTSXP, nlevels));
00140 if (nobs > 0)
00141 SET_VECTOR_ELT(split, S3_SPLITSTATISTICS,
00142 splitstatistics = allocVector(REALSXP, nobs));
00143 else
00144 SET_VECTOR_ELT(split, S3_SPLITSTATISTICS, R_NilValue);
00145 SET_VECTOR_ELT(split, S3_TOLEFT, toleft = allocVector(INTSXP, 1));
00146 INTEGER(toleft)[0] = 1;
00147 SET_VECTOR_ELT(split, S3_TABLE, table = allocVector(INTSXP, nlevels));
00148 }
00149
00150 void S3set_variableID(SEXP split, int variableID) {
00151 INTEGER(VECTOR_ELT(split, S3_VARIABLEID))[0] = variableID;
00152 }
00153
00154 int S3get_variableID(SEXP split) {
00155 return(INTEGER(VECTOR_ELT(split, S3_VARIABLEID))[0]);
00156 }
00157
00158 int S3is_ordered(SEXP split) {
00159 return(INTEGER(VECTOR_ELT(split, S3_ORDERED))[0]);
00160 }
00161
00162 void S3set_ordered(SEXP split) {
00163 INTEGER(VECTOR_ELT(split, S3_ORDERED))[0] = 1;
00164 }
00165
00166 void S3set_nominal(SEXP split) {
00167 INTEGER(VECTOR_ELT(split, S3_ORDERED))[0] = 0;
00168 }
00169
00170 int S3get_toleft(SEXP split) {
00171 return(INTEGER(VECTOR_ELT(split, S3_TOLEFT))[0]);
00172 }
00173
00174 void S3set_toleft(SEXP split, int left) {
00175
00176 INTEGER(VECTOR_ELT(split, S3_TOLEFT))[0] = left;
00177 }
00178
00179 SEXP S3get_splitpoint(SEXP split) {
00180 return(VECTOR_ELT(split, S3_SPLITPOINT));
00181 }
00182
00183 SEXP S3get_splitstatistics(SEXP split) {
00184 SEXP ans;
00185
00186 ans = VECTOR_ELT(split, S3_SPLITSTATISTICS);
00187 if (ans == R_NilValue)
00188 error("split does not have a splitstatistics element");
00189 return(ans);
00190 }
00191
00192 SEXP S3get_table(SEXP split) {
00193 SEXP ans;
00194
00195 ans = VECTOR_ELT(split, S3_TABLE);
00196 if (ans == R_NilValue)
00197 error("split does not have a table element");
00198 return(ans);
00199 }