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