SCM

SCM Repository

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

Diff of /pkg/src/ssclme.c

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

revision 163, Fri May 14 18:06:16 2004 UTC revision 164, Fri May 14 21:00:04 2004 UTC
# Line 1161  Line 1161 
1161      return ans;      return ans;
1162  }  }
1163    
1164  SEXP ssclme_fitted(SEXP x, SEXP facs, SEXP mmats)  SEXP ssclme_fitted(SEXP x, SEXP facs, SEXP mmats, SEXP useRf)
1165  {  {
1166      SEXP val, b;      SEXP val, b;
1167      int *nc = INTEGER(GET_SLOT(x, Matrix_ncSym)),      int *nc = INTEGER(GET_SLOT(x, Matrix_ncSym)),
# Line 1183  Line 1183 
1183      } else {      } else {
1184          memset(vv, 0, sizeof(double) * nobs);          memset(vv, 0, sizeof(double) * nobs);
1185      }      }
1186        if (asLogical(useRf)) {
1187      b = PROTECT(ssclme_ranef(x));      b = PROTECT(ssclme_ranef(x));
1188      for (i = 0; i < nf; i++) {      for (i = 0; i < nf; i++) {
1189          int *ff = INTEGER(VECTOR_ELT(facs, i)), j, nci = nc[i];          int *ff = INTEGER(VECTOR_ELT(facs, i)), j, nci = nc[i];
# Line 1199  Line 1200 
1200              j += nn;              j += nn;
1201          }          }
1202      }      }
1203      UNPROTECT(2);          UNPROTECT(1);
1204        }
1205        UNPROTECT(1);
1206      return val;      return val;
1207  }  }
1208    
# Line 1234  Line 1237 
1237      return Omg;      return Omg;
1238  }  }
1239    
1240    #define slot_dup(sym)  SET_SLOT(ans, sym, duplicate(GET_SLOT(x, sym)))
1241    
1242  SEXP ssclme_collapse(SEXP x)  SEXP ssclme_collapse(SEXP x)
1243  {  {
1244      SEXP ans = PROTECT(NEW_OBJECT(MAKE_CLASS("ssclme"))),      SEXP ans = PROTECT(NEW_OBJECT(MAKE_CLASS("ssclme"))),
1245          Omega = GET_SLOT(x, Matrix_OmegaSym),          Omega = GET_SLOT(x, Matrix_OmegaSym),
1246          Dim = GET_SLOT(x, Matrix_DimSym);          Dim = GET_SLOT(x, Matrix_DimSym);
1247      int i, nf = length(Omega), nz = INTEGER(Dim)[1];      int nf = length(Omega), nz = INTEGER(Dim)[1];
     SEXP copy[] = {Matrix_DSym, Matrix_DIsqrtSym, Matrix_DimSym,  
                    Matrix_GpSym, Matrix_LiSym, Matrix_LpSym,  
                    Matrix_LxSym, Matrix_OmegaSym, Matrix_ParentSym,  
                    Matrix_bVarSym, Matrix_devianceSym,  
                    Matrix_devCompSym, Matrix_iSym, Matrix_ncSym,  
                    Matrix_statusSym, Matrix_pSym, Matrix_xSym};  
   
     for (i = 0; i < 17; i++)  
         SET_SLOT(ans, copy[i], duplicate(GET_SLOT(x, copy[i])));  
1248    
1249        slot_dup(Matrix_DSym);
1250        slot_dup(Matrix_DIsqrtSym);
1251        slot_dup(Matrix_DimSym);
1252        slot_dup(Matrix_GpSym);
1253        slot_dup(Matrix_LiSym);
1254        slot_dup(Matrix_LpSym);
1255        slot_dup(Matrix_LxSym);
1256        slot_dup(Matrix_OmegaSym);
1257        slot_dup(Matrix_ParentSym);
1258        slot_dup(Matrix_bVarSym);
1259        slot_dup(Matrix_devianceSym);
1260        slot_dup(Matrix_devCompSym);
1261        slot_dup(Matrix_iSym);
1262        slot_dup(Matrix_ncSym);
1263        slot_dup(Matrix_statusSym);
1264        slot_dup(Matrix_pSym);
1265        slot_dup(Matrix_xSym);
1266      INTEGER(GET_SLOT(ans, Matrix_ncSym))[nf] = 1;      INTEGER(GET_SLOT(ans, Matrix_ncSym))[nf] = 1;
1267      SET_SLOT(ans, Matrix_XtXSym, allocMatrix(REALSXP, 1, 1));      SET_SLOT(ans, Matrix_XtXSym, allocMatrix(REALSXP, 1, 1));
1268      REAL(GET_SLOT(ans, Matrix_XtXSym))[0] = NA_REAL;      REAL(GET_SLOT(ans, Matrix_XtXSym))[0] = NA_REAL;
# Line 1262  Line 1275 
1275      return ans;      return ans;
1276  }  }
1277    
1278    SEXP ssclme_to_lme(SEXP call, SEXP facs, SEXP x, SEXP model, SEXP REML,
1279                       SEXP rep, SEXP fitted, SEXP residuals)
1280    {
1281        SEXP ans = PROTECT(NEW_OBJECT(MAKE_CLASS("lme")));
1282    
1283        SET_SLOT(ans, install("call"), call);
1284        SET_SLOT(ans, install("facs"), facs);
1285        SET_SLOT(ans, Matrix_xSym, x);
1286        SET_SLOT(ans, install("model"), model);
1287        SET_SLOT(ans, install("REML"), REML);
1288        SET_SLOT(ans, install("rep"), rep);
1289        SET_SLOT(ans, install("fitted"), fitted);
1290        SET_SLOT(ans, install("residuals"), residuals);
1291        UNPROTECT(1);
1292        return ans;
1293    }

Legend:
Removed from v.163  
changed lines
  Added in v.164

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