S3Classes.c

Go to the documentation of this file.
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     /* teststats */
00028     SET_VECTOR_ELT(criterion, S3_STATISTICS, allocVector(REALSXP, ninputs)); 
00029     /* criterion, aka pvalues */
00030     SET_VECTOR_ELT(criterion, S3_iCRITERION, allocVector(REALSXP, ninputs));
00031     /* max(criterion) */
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     /* <FIXME> use LOGICAL here? </FIXME> */
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 }

Generated on Thu Mar 4 17:16:01 2010 for party by  doxygen 1.6.1