The R Project SVN R

R : Copyright 2004, The R Foundation for Statistical Computing
Version 2.0.0 Under development (unstable) (2004-08-30), ISBN 3-900051-00-3

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for a HTML browser interface to help.
Type 'q()' to quit R.

> #### Which functions in R  are    .Primitive()  / which should be ?
> #### ------------------------------------------------------------
> #### M.Maechler, May, 1998.
> ####
> #### text was in ../doc/manual/primitive-funs.tex , now
> #### ==> ../doc/manual/R-exts.texi "@appendix R (internal) ...
> ####   ~~~~~~~~~~~~~~~~~~~~~~~~~
> 
> bpos <- match("package:base",search())
> nn <- ls(pos=bpos, all = TRUE)
> length(nn) # 844 [R 0.62.0, March 25, 1998;  1067 R 0.64.0 March 1999]
[1] 1063
> 
> is.primitive <- function (obj) is.function(obj) && is.null(args(obj))
> is.special <- function(obj) typeof(obj) == "special"
> 
> Primf <- nn[sapply(nn, function(N) is.primitive(get(N, pos=bpos)))]
> length(Primf) ## 195  R 0.62.0, March 25, 1998
[1] 151
> ## 132    R 0.62.2+
> Real.primitives <-
+     list(
+    specials = c("{", "(", "if", "for", "while", "repeat", "break", "next",
+    "return", "function", "quote",
+    "on.exit" ## on.exit(expression, add=F) has two arguments in S-plus !
+    ),
+    language = c("$", "$<-", "@", "<-", "=", "<<-", "[", "[<-", "[[", "[[<-"),
+    arith = c("%%", "%*%", "%/%","*", "+", "-", "/", "^"),
+    logic = c("!",  "&", "&&",  "|", "||",
+    "<", "<=", "==", ">", ">=", "!="),
+    arithF =
+    c("sign", "abs",
+      "floor", "ceiling", "trunc",
+      "sqrt",
+      "exp",   ## NOT: "log",
+      "cos",     "sin",  "tan",
+      "acos",   "asin", "atan", ## Not:  atan2
+      "cosh",   "sinh", "tanh",
+      "acosh","asinh","atanh",
+      "cumsum","cumprod",
+      "cummax", "cummin"
+      ),
+    arithC = c("Arg", "Conj", "Im", "Mod", "Re"),
+ 
+    programming =
+    c("nargs", "missing", # actually args(.) could be as formal(.)
+      "interactive",
+      ".Primitive", ".Internal", ".External", ".Call",
+            ".External.graphics", ".Call.graphics",
+      ".C", ".Fortran", "symbol.C", "symbol.For",
+      "globalenv", "pos.to.env", "unclass",
+            "as.character", "as.environment",
+      ##maybe ? "gc", "gcinfo",
+      ##
+      "debug", "undebug", ".primTrace", ".primUntrace",
+      "browser",  "proc.time", "gc.time", #"traceback",
+      ),
+ 
+    language2= c(":", "~", "c", "list", #nomore (Sep.9,1998): "unlist",
+    # ".Alias", removed for 1.5.0
+    "call", "as.call", "expression", "substitute",
+    "UseMethod", ## ? really ?
+          "standardGeneric",
+    "invisible",
+    ),
+ 
+    language3=
+    c("environment<-",
+      "length",    "length<-",
+      "class", "class<-",
+      "attr", # again
+      "attr<-",
+      "attributes",    "attributes<-",
+      "dim",       "dim<-",
+      "dimnames",  "dimnames<-",
+      ## MM:   "comment", "comment<-",
+      ## New data.frame code
+      ##      "levels", "levels<-",
+      ##      "codes",  "codes<-",
+      ##      "[.data.frame",  "[<-.data.frame",
+      ##      "[[.data.frame", "[[<-.data.frame"
+      ),
+    )
> real.primitives <- unlist(Real.primitives)
> ##names(real.primitives) <- rep("",length(real.primitives))
> 
> !any(duplicated(real.primitives)) # TRUE
[1] TRUE
> all(real.primitives %in% Primf)     # TRUE
[1] TRUE
> 
> "%w/o%" <- function(a,b)  a[! a %in% b]    ## a without b
> 
> prim.f <- Primf %w/o% real.primitives
> ## see below: contains the is.xxxx(.) funtions
> length(prim.f) == length(Primf) - length(real.primitives)# TRUE
[1] TRUE
> 
> Specf <- Primf[iPsp <- sapply(Primf, function(N) is.special(get(N, pos=bpos)))]
> length(Specf) ## 36 [ R 0.63 ]
[1] 40
> Specf
 [1] "$"            "$<-"          "&&"           ".Internal"    "<-"          
 [6] "<<-"          "="            "@"            "UseMethod"    "["           
[11] "[<-"          "[["           "[[<-"         "as.character" "attr<-"      
[16] "break"        "browser"      "c"            "call"         "dim"         
[21] "dim<-"        "dimnames"     "dimnames<-"   "expression"   "for"         
[26] "function"     "if"           "interactive"  "missing"      "nargs"       
[31] "next"         "on.exit"      "quote"        "repeat"       "return"      
[36] "substitute"   "while"        "{"            "||"           "~"           
> ## the non-"special" ones:
> all("builtin" == sapply(Primf[!iPsp], function(N) typeof(get(N, pos=bpos))))
[1] TRUE
> 
> 
> ncpf <- nchar(prim.f)
> table(ncpf)
ncpf
 5  6  7  8  9 10 11 12 13 14 
 1  1  6  3  8  5  4  2  2  1 
> prim.f[ncpf <= 6]#  only is.na, is.nan
[1] "is.na"  "is.nan"
> 
> ( prim.isf <- prim.f[p.isis <- substr(prim.f,1,2) == "is"] )
 [1] "is.array"       "is.atomic"      "is.call"        "is.character"  
 [5] "is.complex"     "is.double"      "is.environment" "is.expression" 
 [9] "is.finite"      "is.function"    "is.infinite"    "is.integer"    
[13] "is.language"    "is.list"        "is.loaded"      "is.logical"    
[17] "is.matrix"      "is.na"          "is.name"        "is.nan"        
[21] "is.null"        "is.numeric"     "is.object"      "is.pairlist"   
[25] "is.real"        "is.recursive"   "is.single"      "is.symbol"     
> 
> length(prim.f2 <- prim.f[! p.isis]) # down to 87   [R 0.62.0, March 25, 1998]
[1] 5
>                   # 61  [March 27]
>                   # 43  [April 17];  38 [April 22]
> ##-> 0    [May 1, 1998]
> 
> prim.f2 # character(0) --- none left! --
[1] ".subset"       ".subset2"      "oldClass"      "oldClass<-"   
[5] "reg.finalizer"
> 
> for(n in prim.f2)
+     cat(n," <- function(*) .Internal(",n,"(*))\n", sep="")
.subset <- function(*) .Internal(.subset(*))
.subset2 <- function(*) .Internal(.subset2(*))
oldClass <- function(*) .Internal(oldClass(*))
oldClass<- <- function(*) .Internal(oldClass<-(*))
reg.finalizer <- function(*) .Internal(reg.finalizer(*))
>