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

dummyvar.c

Go to the documentation of this file.
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]) { /* == TRUE */
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 

Generated on Thu Jun 9 14:12:17 2005 for party by  doxygen 1.4.2