00001
00002 #include <R.h>
00003 #include <Rmath.h>
00004 #include <Rdefines.h>
00005 #include <Rinternals.h>
00006 #include "party.h"
00007
00008 SEXP dummyvar(SEXP x, SEXP transposed) {
00009
00010 int nlevels, n, i, j;
00011
00012 SEXP ans;
00013 SEXP levels;
00014 SEXP dimnames;
00015
00016 if (!isFactor(x)) error("x is not a factor\n");
00017 if (!isLogical(transposed)) error("transposed is not a logical\n");
00018
00019 n = LENGTH(x);
00020 levels = GET_LEVELS(x);
00021 nlevels = LENGTH(levels);
00022
00023 if (LOGICAL(transposed)[0]) {
00024 PROTECT(ans = allocMatrix(INTSXP, nlevels, n));
00025
00026 for (i = 0; i < n; i++) {
00027 for (j = 0; j < nlevels; j++) {
00028 if (INTEGER(x)[i] == (j+1))
00029 INTEGER(ans)[aindx(j, i, nlevels)] = 1;
00030 else
00031 INTEGER(ans)[aindx(j, i, nlevels)] = 0;
00032 }
00033 }
00034 PROTECT(dimnames = allocVector(VECSXP, 2));
00035 SET_VECTOR_ELT(dimnames, 0, levels);
00036 SET_VECTOR_ELT(dimnames, 1, R_NilValue);
00037 setAttrib(ans, R_DimNamesSymbol, dimnames);
00038 } else {
00039 PROTECT(ans = allocMatrix(INTSXP, n, nlevels));
00040
00041 for (i = 0; i < n; i++) {
00042 for (j = 0; j < nlevels; j++) {
00043 if (INTEGER(x)[i] == (j+1))
00044 INTEGER(ans)[aindx(i, j, n)] = 1;
00045 else
00046 INTEGER(ans)[aindx(i, j, n)] = 0;
00047 }
00048 }
00049
00050 PROTECT(dimnames = allocVector(VECSXP, 2));
00051 SET_VECTOR_ELT(dimnames, 0, R_NilValue);
00052 SET_VECTOR_ELT(dimnames, 1, levels);
00053 setAttrib(ans, R_DimNamesSymbol, dimnames);
00054 }
00055 UNPROTECT(2);
00056 return(ans);
00057 }
00058
00059 SEXP contcat (SEXP x, SEXP cutpoints) {
00060
00061 int i, j, nx, nc;
00062 SEXP ans, rx, rc;
00063
00064 PROTECT(rx = coerceVector(x, REALSXP));
00065 PROTECT(rc = coerceVector(cutpoints, REALSXP));
00066
00067 nx = LENGTH(rx);
00068 nc = LENGTH(rc);
00069
00070 PROTECT(ans = allocMatrix(INTSXP, nc, nx));
00071
00072 for (i = 0; i < nx; i++) {
00073 for (j = 0; j < nc; j++) {
00074 if (REAL(rx)[i] <= REAL(rc)[j]) {
00075 INTEGER(ans)[aindx(j, i, nc)] = 1;
00076 } else {
00077 INTEGER(ans)[aindx(j, i, nc)] = 0;
00078 }
00079 }
00080 }
00081
00082 UNPROTECT(3);
00083 return(ans);
00084 }
00085