SCM

SCM Repository

[matrix] Diff of /pkg/src/sscCrosstab.c
ViewVC logotype

Diff of /pkg/src/sscCrosstab.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 85, Thu Apr 15 20:50:57 2004 UTC revision 86, Thu Apr 15 21:40:17 2004 UTC
# Line 125  Line 125 
125    * @param n number of columns in the matrix    * @param n number of columns in the matrix
126    * @param Ap column pointers in Ai (modified)    * @param Ap column pointers in Ai (modified)
127    * @param Ai row indices (modified)    * @param Ai row indices (modified)
128    * @param iperm on return contains the inverse permutation    * @param perm on return contains the permutation of the rows
129      * @param useL when more than one row matches maxrc, use last match
130    */    */
131  static  static
132  void pair_perm(int m, int n, int Ap[], int Ai[], int iperm[])  void pair_perm(int m, int n, int Ap[], int Ai[], int iperm[], int useL)
133  {  {
134      int *cc = Calloc(n, int),   /* column counts */      int *cc = Calloc(n, int),   /* column counts */
135          ii, j,          ii, j,
# Line 158  Line 159 
159          maxrc = -1;             /* find last row with rc[i] == max(rc) */          maxrc = -1;             /* find last row with rc[i] == max(rc) */
160          for (i = 0; i < m; i++) {          for (i = 0; i < m; i++) {
161              int ic = rc[i];              int ic = rc[i];
162              if (ic >= maxrc) {              if (ic > maxrc || (useL && ic == maxrc)) {
163                  maxrc = ic;                  maxrc = ic;
164                  rr = i;                  rr = i;
165              }              }
166          }          }
167    
168          iperm[ii] = rr;          iperm[rr] = ii;
169    
170          p1 = p3 = 0;            /* update cc, Ap and Ai */          p1 = p3 = 0;            /* update cc, Ap and Ai */
171          for (j = 0; j < n; j++) {          for (j = 0; j < n; j++) {
# Line 185  Line 186 
186      Free(cc); Free(rc);      Free(cc); Free(rc);
187  }  }
188    
189  SEXP sscCrosstab_groupedPerm(SEXP ctab)  SEXP sscCrosstab_groupedPerm(SEXP ctab, SEXP useLast)
190  {  {
191      SEXP      SEXP
192          GpSlot = GET_SLOT(ctab, Matrix_GpSym),          GpSlot = GET_SLOT(ctab, Matrix_GpSym),
# Line 194  Line 195 
195      int *Ai = INTEGER(iSlot),      int *Ai = INTEGER(iSlot),
196          *Ap = INTEGER(pSlot),          *Ap = INTEGER(pSlot),
197          *Gp = INTEGER(GpSlot),          *Gp = INTEGER(GpSlot),
198            useL = asLogical(useLast),
199          i,          i,
200          n = length(pSlot) - 1,  /* number of columns */          n = length(pSlot) - 1,  /* number of columns */
201          nf = length(GpSlot) - 1, /* number of factors */          nf = length(GpSlot) - 1, /* number of factors */
202          *np = Calloc(n + 1, int), /* column pointers */          *np = Calloc(n + 1, int), /* column pointers */
203          *ni = Calloc(length(iSlot) - n, int); /* row indices */          *ni = Calloc(length(iSlot) - n, int); /* row indices */
204      SEXP ans = PROTECT(allocVector(INTSXP, n));      SEXP ans = PROTECT(allocVector(INTSXP, n));
     int *iperm = Calloc(n, int);  
205    
206      if (toupper(*CHAR(STRING_ELT(GET_SLOT(ctab, Matrix_uploSym), 0))) != 'L')      if (toupper(*CHAR(STRING_ELT(GET_SLOT(ctab, Matrix_uploSym), 0))) != 'L')
207          error("Lower triangle required in sscCrosstab object");          error("Lower triangle required in sscCrosstab object");
208    
209      for (i = 0; i < n; i++) {      for (i = 0; i < n; i++) {
210          iperm[i] = i;    /* initialize inverse permutation to identity */          INTEGER(ans)[i] = i;    /* initialize permutation to identity */
211      }      }
212      np[0] = 0;      np[0] = 0;
213    
# Line 223  Line 224 
224              }              }
225              np[j + 1 - p1] = p0;              np[j + 1 - p1] = p0;
226          }          }
227          pair_perm(p3 - p2, p2 - p1, np, ni, iperm + p2);          pair_perm(p3 - p2, p2 - p1, np, ni, INTEGER(ans) + p2, useL);
228          for (j = p2; j < p3; j++) iperm[j] += p2;          for (j = p2; j < p3; j++) INTEGER(ans)[j] += p2;
229      }      }
230    
231      for(i = 0; i < n; i++) {    /* invert the permutation */      Free(np); Free(ni);
         INTEGER(ans)[iperm[i]] = i;  
     }  
     Free(np); Free(ni); Free(iperm);  
232      UNPROTECT(1);      UNPROTECT(1);
233      return ans;      return ans;
234  }  }

Legend:
Removed from v.85  
changed lines
  Added in v.86

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge