# SCM Repository

[matrix] Diff of /pkg/src/lmer.c
 [matrix] / pkg / src / lmer.c

# Diff of /pkg/src/lmer.c

revision 465, Sat Jan 29 14:14:01 2005 UTC revision 466, Sat Jan 29 14:14:31 2005 UTC
# Line 23  Line 23
23  }  }
24
25  /**  /**
26   * Calculate the zero-based index in a packed lower triangular matrix.  This is   * Calculate the zero-based index in a row-wise packed lower triangular matrix.
27   * used for the arrays of blocked sparse matrices.   * This is used for the arrays of blocked sparse matrices.
28   *   *
29   * @param i column number (zero-based)   * @param i column number (zero-based)
30   * @param k row number (zero-based)   * @param k row number (zero-based)
# Line 35  Line 35
35  int Lind(int k, int i)  int Lind(int k, int i)
36  {  {
37      if (k < i) error("Lind(k = %d, i = %d) must have k >= i", k, i);      if (k < i) error("Lind(k = %d, i = %d) must have k >= i", k, i);
38      return (i * (i + 1))/2 + k;      return (k * (k + 1))/2 + i;
39  }  }
40
41  /**  /**
# Line 105  Line 105
105          if (rowind[k] == i) return k;          if (rowind[k] == i) return k;
106      error("row %d and column %d not defined in rowind and colptr",      error("row %d and column %d not defined in rowind and colptr",
107            i, j);            i, j);
108      return -1;                  /* to keep -Wall happy */      return -1;                  /* -Wall */
109  }  }
110
111  /**  /**
# Line 123  Line 123
123      int i, nf = length(flist);      int i, nf = length(flist);
124      int npairs = (nf * (nf + 1))/2;      int npairs = (nf * (nf + 1))/2;
125      SEXP val = PROTECT(allocVector(VECSXP, npairs));      SEXP val = PROTECT(allocVector(VECSXP, npairs));
126      SEXP cscbCl = MAKE_CLASS("cscBlocked");      SEXP cscbCl = PROTECT(MAKE_CLASS("cscBlocked"));
127      int *Ti = Calloc(nobs, int),      int *Ti = Calloc(nobs, int),
128          *nlevs = Calloc(nf, int),          *nlevs = Calloc(nf, int),
129          **zb = Calloc(nf, int*); /* zero-based indices */          **zb = Calloc(nf, int*); /* zero-based indices */
# Line 161  Line 161
161
162      for (i = 0; i < nf; i++) Free(zb[i]);      for (i = 0; i < nf; i++) Free(zb[i]);
163      Free(zb); Free(nlevs); Free(ones); Free(Ti); Free(Tx);      Free(zb); Free(nlevs); Free(ones); Free(Ti); Free(Tx);
164      UNPROTECT(1);      UNPROTECT(2);
165      return val;      return val;
166  }  }
167
# Line 1532  Line 1532
1532      return Omg;      return Omg;
1533  }  }
1534
1535    SEXP lmer_Crosstab(SEXP flist)
1536    {
1537        SEXP val;
1538        int i, nf = length(flist), nobs;
1539        int *nc = Calloc(nf, int);
1540
1541        if (!(nf > 0 && isNewList(flist)))
1542            error("flist must be a non-empty list");
1543        nobs = length(VECTOR_ELT(flist, 0));
1544        if (nobs < 1) error("flist[[0]] must be a non-null factor");
1545        for (i = 0; i < nf; i++) {
1546            SEXP fi = VECTOR_ELT(flist, i);
1547            if (!(isFactor(fi) && length(fi) == nobs))
1548                error("flist[[%d]] must be a factor of length %d",
1549                      i + 1, nobs);
1550            nc[i] = 1;
1551        }
1552        val = lmer_crosstab(flist, nobs, nc);
1553        Free(nc);
1554        return val;
1555    }

Legend:
 Removed from v.465 changed lines Added in v.466