Main Page | Directories | File List | File Members | Related Pages

# 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 %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     /* teststats */
    00027     SET_VECTOR_ELT(criterion, S3_STATISTICS, allocVector(REALSXP, ninputs));
    00028     /* criterion, aka pvalues */
    00029     SET_VECTOR_ELT(criterion, S3_iCRITERION, allocVector(REALSXP, ninputs));
    00030     /* max(criterion) */
    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     /* <FIXME> use LOGICAL here? </FIXME> */
    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 }