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 }

Generated on Fri Aug 25 14:30:01 2006 for party by  doxygen 1.4.4