[fbf06f]: / partyMod / src / S3Classes.c

Download this file

200 lines (157 with data), 6.0 kB

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
/**
S3 classes for dealing with nodes and splits
*\file S3Classes.c
*\author $Author$
*\date $Date$
*/
#include "party.h"
void C_init_node(SEXP node, int nobs, int ninputs, int nsurr, int q) {
SEXP nodeID, weights, criterion, primarysplit, surrogatesplits,
terminal, prediction;
if (LENGTH(node) < NODE_LENGTH)
error("node is not a list with at least %d elements", NODE_LENGTH);
SET_VECTOR_ELT(node, S3_NODEID, nodeID = allocVector(INTSXP, 1));
if (nobs > 0)
SET_VECTOR_ELT(node, S3_WEIGHTS, weights = allocVector(REALSXP, nobs));
else
SET_VECTOR_ELT(node, S3_WEIGHTS, R_NilValue);
SET_VECTOR_ELT(node, S3_SUMWEIGHTS, allocVector(REALSXP, 1));
SET_VECTOR_ELT(node, S3_CRITERION,
criterion = allocVector(VECSXP, CRITERION_LENGTH));
/* teststats */
SET_VECTOR_ELT(criterion, S3_STATISTICS, allocVector(REALSXP, ninputs));
/* criterion, aka pvalues */
SET_VECTOR_ELT(criterion, S3_iCRITERION, allocVector(REALSXP, ninputs));
/* max(criterion) */
SET_VECTOR_ELT(criterion, S3_MAXCRITERION, allocVector(REALSXP, 1));
SET_VECTOR_ELT(node, S3_TERMINAL, terminal = allocVector(LGLSXP, 1));
INTEGER(terminal)[0] = 0;
SET_VECTOR_ELT(node, S3_PSPLIT,
primarysplit = allocVector(VECSXP, SPLIT_LENGTH));
SET_VECTOR_ELT(node, S3_SSPLIT,
surrogatesplits = allocVector(VECSXP, nsurr));
SET_VECTOR_ELT(node, S3_PREDICTION, prediction = allocVector(REALSXP, q));
}
void S3set_nodeID(SEXP node, int nodeID) {
INTEGER(VECTOR_ELT(node, S3_NODEID))[0] = nodeID;
}
int S3get_nodeID(SEXP node) {
return(INTEGER(VECTOR_ELT(node, S3_NODEID))[0]);
}
SEXP S3get_nodeweights(SEXP node) {
SEXP ans;
ans = VECTOR_ELT(node, S3_WEIGHTS);
if (ans == R_NilValue)
error("node has no weights element");
return(VECTOR_ELT(node, S3_WEIGHTS));
}
double S3get_sumweights(SEXP node) {
return(REAL(VECTOR_ELT(node, S3_SUMWEIGHTS))[0]);
}
SEXP S3get_teststat(SEXP node) {
return(VECTOR_ELT(VECTOR_ELT(node, S3_CRITERION), S3_STATISTICS));
}
SEXP S3get_criterion(SEXP node) {
return(VECTOR_ELT(VECTOR_ELT(node, S3_CRITERION), S3_iCRITERION));
}
SEXP S3get_maxcriterion(SEXP node) {
return(VECTOR_ELT(VECTOR_ELT(node, S3_CRITERION), S3_MAXCRITERION));
}
void S3set_nodeterminal(SEXP node) {
INTEGER(VECTOR_ELT(node, S3_TERMINAL))[0] = 1;
}
int S3get_nodeterminal(SEXP node) {
return(INTEGER(VECTOR_ELT(node, S3_TERMINAL))[0]);
}
SEXP S3get_primarysplit(SEXP node) {
return(VECTOR_ELT(node, S3_PSPLIT));
}
SEXP S3get_surrogatesplits(SEXP node) {
return(VECTOR_ELT(node, S3_SSPLIT));
}
SEXP S3get_prediction(SEXP node) {
return(VECTOR_ELT(node, S3_PREDICTION));
}
SEXP S3get_leftnode(SEXP node) {
return(VECTOR_ELT(node, S3_LEFT));
}
SEXP S3get_rightnode(SEXP node) {
return(VECTOR_ELT(node, S3_RIGHT));
}
void C_init_orderedsplit(SEXP split, int nobs) {
SEXP variableID, splitpoint, splitstatistics, ordered, toleft;
if (LENGTH(split) < SPLIT_LENGTH)
error("split is not a list with at least %d elements", SPLIT_LENGTH);
SET_VECTOR_ELT(split, S3_VARIABLEID,
variableID = allocVector(INTSXP, 1));
SET_VECTOR_ELT(split, S3_ORDERED,
ordered = allocVector(LGLSXP, 1));
INTEGER(ordered)[0] = 1;
SET_VECTOR_ELT(split, S3_SPLITPOINT,
splitpoint = allocVector(REALSXP, 1));
if (nobs > 0)
SET_VECTOR_ELT(split, S3_SPLITSTATISTICS,
splitstatistics = allocVector(REALSXP, nobs));
else
SET_VECTOR_ELT(split, S3_SPLITSTATISTICS, R_NilValue);
SET_VECTOR_ELT(split, S3_TOLEFT, toleft = allocVector(INTSXP, 1));
INTEGER(toleft)[0] = 1;
SET_VECTOR_ELT(split, S3_TABLE, R_NilValue);
}
void C_init_nominalsplit(SEXP split, int nlevels, int nobs) {
SEXP variableID, splitpoint, splitstatistics, ordered, toleft, table;
if (LENGTH(split) < SPLIT_LENGTH)
error("split is not a list with at least %d elements", SPLIT_LENGTH);
SET_VECTOR_ELT(split, S3_VARIABLEID, variableID = allocVector(INTSXP, 1));
SET_VECTOR_ELT(split, S3_ORDERED, ordered = allocVector(LGLSXP, 1));
INTEGER(ordered)[0] = 0;
SET_VECTOR_ELT(split, S3_SPLITPOINT,
splitpoint = allocVector(INTSXP, nlevels));
if (nobs > 0)
SET_VECTOR_ELT(split, S3_SPLITSTATISTICS,
splitstatistics = allocVector(REALSXP, nobs));
else
SET_VECTOR_ELT(split, S3_SPLITSTATISTICS, R_NilValue);
SET_VECTOR_ELT(split, S3_TOLEFT, toleft = allocVector(INTSXP, 1));
INTEGER(toleft)[0] = 1;
SET_VECTOR_ELT(split, S3_TABLE, table = allocVector(INTSXP, nlevels));
}
void S3set_variableID(SEXP split, int variableID) {
INTEGER(VECTOR_ELT(split, S3_VARIABLEID))[0] = variableID;
}
int S3get_variableID(SEXP split) {
return(INTEGER(VECTOR_ELT(split, S3_VARIABLEID))[0]);
}
int S3is_ordered(SEXP split) {
return(INTEGER(VECTOR_ELT(split, S3_ORDERED))[0]);
}
void S3set_ordered(SEXP split) {
INTEGER(VECTOR_ELT(split, S3_ORDERED))[0] = 1;
}
void S3set_nominal(SEXP split) {
INTEGER(VECTOR_ELT(split, S3_ORDERED))[0] = 0;
}
int S3get_toleft(SEXP split) {
return(INTEGER(VECTOR_ELT(split, S3_TOLEFT))[0]);
}
void S3set_toleft(SEXP split, int left) {
/* <FIXME> use LOGICAL here? </FIXME> */
INTEGER(VECTOR_ELT(split, S3_TOLEFT))[0] = left;
}
SEXP S3get_splitpoint(SEXP split) {
return(VECTOR_ELT(split, S3_SPLITPOINT));
}
SEXP S3get_splitstatistics(SEXP split) {
SEXP ans;
ans = VECTOR_ELT(split, S3_SPLITSTATISTICS);
if (ans == R_NilValue)
error("split does not have a splitstatistics element");
return(ans);
}
SEXP S3get_table(SEXP split) {
SEXP ans;
ans = VECTOR_ELT(split, S3_TABLE);
if (ans == R_NilValue)
error("split does not have a table element");
return(ans);
}