etc/R-ESS-bugs.R

   1 #### File showing off  things that go wrong -- with R-mode
   2
   3 ## From: Robert Gentleman <rgentlem@fhcrc.org>
   4 ## To: Martin Maechler <maechler@stat.math.ethz.ch>
   5 ## Subject: ESS buglet
   6 ## Date: Sun, 01 Jul 2007 21:41:24 -0700
   7
   8 ## Hi Martin,
   9 ##   It seems that the following buglet exists (at least in what ever
  10 ## version I am using)
  11
  12 ##a silly comment
  13 ##and a second one
  14 foo <- function(x=a, abc = list("def", a=1,3,3), more.args, and, bla,
  15                 blu, bl
  16                 another, and, another, and bmbasd,
  17                 lots = NULL,
  18                 more = NULL,
  19                 args = NULL)
  20
  21 ##-   when the line before a function def is a comment, and adding args,
  22 ##- then new lines, when generated have a comment char at the beginning of
  23 ##- the line. It is slighly annoying as I have to remove the comment char.
  24 ##-
  25 ##- If I add a blank line after the comment line, then the problem does not
  26 ##- occur.
  27 ## and another ''anonymous'' function:
  28 function(x=a, abc = list("def", a=c(1,3,3)), more.args, and, bla, blu,
  29          blo, blu, bla
  30          another, and, another, and, bmbasd) {
  31     ...; ...
  32 }
  33
  34
  35 ### --- Suggestion (Jenny Brian): --> Create a (defun ess-eval-multiline .)
  36 ### Here is useful valid R "test code":
  37
  38 ## From 'example(plot.default)' :
  39
  40 Speed <- cars$speed
  41 Distance <- cars$dist
  42 plot(Speed, Distance, panel.first = grid(8,8),
  43      pch = 0, cex = 1.2, col = "blue")
  44 pp <- plot(Speed, Distance, panel.first = grid(8,8),
  45            pch = 0, cex = 1.2, col = "blue")
  46 plot(Speed, Distance,
  47      panel.first = lines(lowess(Speed, Distance), lty = "dashed"),
  48      pch = 0, cex = 1.2, col = "blue")
  49
  50
  51
  52
  53
  54 ### Here, the indentation is wrong:
  55
  56 a <- function(ch) {
  57     if(ch == Inf) {
  58         E.cond <- numeric(nb)
  59     }
  60     else {
  61         indic  <- ifelse(jinf+1 <= 1 & jsup >= 1,1,0)
  62         E.cond <- ch*(-pbinom(jinf,ni,prb) + 1-pbinom(js.n,ni,prb)) +
  63             ifelse(ni == 1, prb*indic,
  64                    mu*(pbinom(js.n-1,pmax(ni-1,1),prb)-
  65                        pbinom(jinf-1,pmax(ni-1,1),prb))) / sV -
  66 ### why is the following line wrongly indented by Emacs/ESS ?
  67                            mu/sV*(pbinom(js.n,ni,prb) - pbinom(jinf,ni,prb))
  68
  69         indic2 <- ifelse(jinf+1 <= 1 & jsup >= 1 & ni == 2,1,0)
  70
  71     }
  72 }
  73
  74
  75 ### Here, the beginning of function is not found correctly, and hence
  76 ###       all "ess-*-function" (C-M-a, C-M-e, ...) fail:
  77
  78 setMeneric <-
  79   ## It is clearly allowed to have comments here.
  80   ## S version 4, and John Chambers in particular like it.
  81   ##
  82   ## BUG: M-C-e or M-C-a fails from ``here'' --
  83   ## ---  effectively because of ess-beginning-of-function fails
  84   ## and that really relies on finding  ess-function-pattern;
  85   ## i.e., ess-R-function-pattern in ~/emacs/ess/lisp/ess-cust.el
  86   ##
  87     function(name, def = NULL, group = list(), valueClass = character(),
  88              where = topenv(parent.frame()), genericFunction = NULL)
  89 {
  90     ## comments in here are at least kept via "source" attribute
  91     if(exists(name, "package:base") &&
  92        typeof(get(name, "package:base")) != "closure") {
  93         FALSE
  94     }
  95     "ABC"
  96 }
  97
  98 ## this has one line more before 'function' than "typically:"
  99 setMethod("[", signature(x = "dgTMatrix", i = "numeric", j = "missing",
 100                          drop = "logical"),
 101           function (x, i, j, ..., drop) { ## select rows
 102               storage.mode(i) <- "integer"
 103               xi <- x@i + 1:1 # 1-indexing
 104               ## ...................
 105               if (drop && any(nd == 1)) drop(as(x,"matrix")) else x
 106           })
 107
 108 "dimnames<-.data.frame" <- function(x, value) {
 109     d <- dim(x)
 110     if(!is.list(value) || length(value) != 2
 111        || d[[1]] != length(value[[1]])
 112        || d[[2]] != length(value[[2]]))
 113         stop("invalid 'dimnames' given for data frame")
 114     row.names(x) <- as.character(value[[1]]) # checks validity
 115     names(x) <- as.character(value[[2]])
 116     x
 117 }
 118
 119 '[.foo' <- function(x, i, value)
 120 {
 121 ###
 122     y <- x
 123     y[i] <- value
 124     y
 125 }
 126
 127 '[[.bar' <- function(x, i, value)
 128 {
 129     ## bla bla bla
 130     y <- as.foo(x) ; y[[i]] <- value
 131     y
 132 }
 133
 134 "[<-.foobar" <- function(x,i,j,value) {
 135     ## just something
 136     x
 137 }
 138
 139 "names<-.foobar" <- function(x, value) {
 140     ## just something else
 141     x
 142 }
 143
 144 "[<-.data.frame" <- function(x, i, j, value)
 145 {
 146     nA <- nargs() # value is never missing, so 3 or 4.
 147
 148 ###..........
 149
 150     class(x) <- cl
 151     x
 152 }
 153
 154 "[[<-.data.frame"<- function(x, i, j, value)
 155 {
 156     cl <- oldClass(x)
 157     ## delete class: Version 3 idiom
 158     ## to avoid any special methods for [[<-
 159     class(x) <- NULL
 160
 161 ###...........
 162
 163     class(x) <- cl
 164     x
 165 }
 166
 167
 168 "$<-.data.frame"<- function(x, i, value)
 169 {
 170     cl <- oldClass(x)
 171     ## delete class: Version 3 idiom
 172     ## to avoid any special methods for [[<-
 173
 174 ###...........
 175
 176     class(x) <- cl
 177     return(x)
 178 }