SCM

SCM Repository

[matrix] Diff of /pkg/Matrix/src/Mutils.h
ViewVC logotype

Diff of /pkg/Matrix/src/Mutils.h

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

revision 2336, Fri Feb 13 15:07:27 2009 UTC revision 2348, Mon Mar 23 16:50:14 2009 UTC
# Line 69  Line 69 
69  /* int csc_unsorted_columns(int ncol, const int p[], const int i[]); */  /* int csc_unsorted_columns(int ncol, const int p[], const int i[]); */
70  /* void csc_sort_columns(int ncol, const int p[], int i[], double x[]); */  /* void csc_sort_columns(int ncol, const int p[], int i[], double x[]); */
71  /* SEXP csc_check_column_sorting(SEXP A); */  /* SEXP csc_check_column_sorting(SEXP A); */
72  SEXP Matrix_make_named(int TYP, char **names);  SEXP Matrix_make_named(int TYP, const char **names);
73  SEXP check_scalar_string(SEXP sP, char *vals, char *nm);  SEXP check_scalar_string(SEXP sP, char *vals, char *nm);
74  Rboolean equal_string_vectors(SEXP s1, SEXP s2);  Rboolean equal_string_vectors(SEXP s1, SEXP s2);
75    
# Line 270  Line 270 
270      }      }
271  }  }
272    
273    /**
274     * Return the 0-based index of a match in a vector of class-name strings
275     * terminated by an empty string.  Returns -1 for no match.
276     *
277     * @param x  an R object, potentially with  is(x, <someClass>)
278     * @param valid vector of possible matches terminated by an empty string.
279     * @param rho  the environment in which the class definitions exist.
280     *
281     * @return index of match or -1 for no match
282     */
283    static R_INLINE int
284    Matrix_check_class_and_super(SEXP x, char **valid, SEXP rho)
285    {
286        int ans;
287        SEXP cl = getAttrib(x, R_ClassSymbol);
288        char *class = strdup(CHAR(asChar(cl)));
289        for (ans = 0; ; ans++) {
290            if (!strlen(valid[ans]))
291                break;
292            if (!strcmp(class, valid[ans])) return ans;
293        }
294        /* if not found directly, now search the non-virtual super classes :*/
295        if(IS_S4_OBJECT(x)) {
296            /* now try the superclasses, i.e.,  try   is(x, "....") : */
297            SEXP classDef = eval(lang2(install("getClassDef"), cl), rho),
298                superCl   = eval(lang2(install("nonVirtualSuperClasses"), classDef),
299                                 rho);
300            int i;
301            const char *s_class;
302            for(i=0; i < length(superCl); i++) {
303                s_class = CHAR(STRING_ELT(superCl, i));
304                for (ans = 0; ; ans++) {
305                    if (!strlen(valid[ans]))
306                        break;
307                    if (!strcmp(s_class, valid[ans])) return ans;
308                }
309            }
310        }
311        return -1;
312    }
313    
314    
315  #ifdef __cplusplus  #ifdef __cplusplus
316  }  }

Legend:
Removed from v.2336  
changed lines
  Added in v.2348

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