1#### File showing off  things that go wrong or *went* wrong in the past #### -- with R-mode (mostly coded in ../lisp/ess-mode.el )
2
3### NOTE: this file is indented with RRR style !!!!!
4### but do not change indentations anymore of anything in here:
5### expressions are written as we *want* them, not as ESS currently puts them
6
7options(keep.source = FALSE) # so we see R's deparse() + print() indentation
8
9
10### --- 1 ---------  extraneous comment chars :  This seems fixed
11
12## From: Robert Gentleman <rgentlem@fhcrc.org>
13## To: Martin Maechler <maechler@stat.math.ethz.ch>
14## Subject: ESS buglet
15## Date: Sun, 01 Jul 2007 21:41:24 -0700
16
17## Hi Martin,
18##   It seems that the following buglet exists (at least in what ever
19## version I am using)
20
21##a silly comment
22##and a second one
23foo <- function(x=a, abc = list("def", a=1,3,3), more.args, and, bla,
24                blu, bl,
25                another, plus, yet.another, and_mbasd,
26                lots = NULL,
27                more = NULL,
28                args = NULL) {
29    x
30}
31
32##-   when the line before a function def is a comment, and adding args,
33##- then new lines, when generated have a comment char at the beginning of
34##- the line. It is slightly annoying as I have to remove the comment char.
35##-
36##- If I add a blank line after the comment line, then the problem does not
37##- occur.
38## and another ''anonymous'' function:
39function(x=a, abc = list("def", a=c(1,3,3)), more.args, and, bla, blu,
40         blo, Abc,
41         def,
42         another, and_another, and_this) {
43    ...; ...
44}
45
46## This is a "TRUE" example (from Matrix/tests/ ):
47NA.or.True <- function(x) is.na(x) | x
48
49abc <- function(x, y, ...) this.is.just.a.one.liner(x,y, z=TRUE, ...)
50
51## A more-liner function with no "{...}" -- this one even works (but not all!)
52mindiff <- function(df) df[which.min(df$diff),
53                           which.max(df$daff)]
54
55## Two functions in one line - can I "send" just one of them? {no, not "simply"}
56f1 <- function(x) be.friendly(x, force=TRUE); f2 <- function(x,y) x*sin(pi*x)
57
58### --- 2 ----------------------------------------------------------------
59### --- Suggestion (Jenny Brian): --> Create a (defun ess-eval-multiline .)
60## Here is useful valid R "test code":
61
62## From 'example(plot.default)' :
63
64Speed <- cars$speed
65Distance <- cars$dist
66plot(Speed, Distance, panel.first = grid(8,8),
67     pch = 0, cex = 1.2, col = "blue")
68pp <- plot(Speed, Distance, panel.first = grid(8,8),
69           pch = 0, cex = 1.2, col = "blue")
70plot(Speed, Distance,
71     panel.first = lines(lowess(Speed, Distance), lty = "dashed"),
72     pch = 0, cex = 1.2, col = "blue")
73
74## Note: We now at least C-c C-c {ess-eval-function-or-paragraph-and-step}
75
76### --- 3 ----------------------------------------------------------------
77###--- This one (from the Matrix package) is for testing ess-roxy...,
78## i.e.,  C-c C-o
79
80## not exported but used more than once for "dimnames<-" method :
81## -- or do only once for all "Matrix" classes ??
82dimnamesGets <- function (x, value) {
83    d <- dim(x)
84    if (!is.list(value) || length(value) != 2 ||
85        !(is.null(v1 <- value[[1]]) || length(v1) == d[1]) ||
86        !(is.null(v2 <- value[[2]]) || length(v2) == d[2]))
87        stop(gettextf("invalid dimnames given for '%s' object", class(x)))
88    x@Dimnames <- list(if(!is.null(v1)) as.character(v1),
89                       if(!is.null(v2)) as.character(v2))
90    x
91}
92
93### --- 4 ----------------------------------------------------------------
94### continued statements
95a <- function(ch) {
96    if(ch == Inf) {
97        E.cond <- numeric(nb)
98    }
99    else {
100        indic  <- ifelse(jinf+1 <= 1 & jsup >= 1,1,0)
101        E.cond <- ch*(-pbinom(jinf,ni,prb) + 1-pbinom(js.n,ni,prb)) +
102            ifelse(ni == 1, prb*indic,
103                   mu*(pbinom(js.n-1,pmax(ni-1,1),prb) -
104                       pbinom(jinf-1,pmax(ni-1,1),prb))) / sV -
105###                    ^-- now here (better)
106            mu/sV*(pbinom(js.n,ni,prb) - pbinom(jinf,ni,prb))
107###         ^-- now here (ok; more indentation would also be ok)
108        indic2 <- ifelse(jinf+1 <= 1 & jsup >= 1 & ni == 2,1,0)
109    }
110}
111
112
113### --- 5 ----------------------------------------------------------------
114### The beginning of function is not found correctly, and hence
115###       all "ess-*-function" (C-M-a, C-M-e, ...) fail:
116
117setMeneric <-
118    ## It is clearly allowed to have comments here.
119    ## S version 4, and John Chambers in particular like it.
120    ##
121    ## BUG: M-C-e or M-C-a fails from ``here'' --
122    ## ---  effectively because of ess-beginning-of-function fails
123    ## and that really relies on finding  ess-function-pattern;
124    ## i.e., ess-R-function-pattern in ~/emacs/ess/lisp/ess-cust.el
125    ##
126    function(name, def = NULL, group = list(), valueClass = character(),
127             where = topenv(parent.frame()), genericFunction = NULL)
128{
129    ## comments in here are at least kept via "source" attribute
130    if(exists(name, "package:base") &&
131       typeof(get(name, "package:base")) != "closure") {
132        FALSE
133    }
134    "ABC"
135}
136
137### --- 6 ----------------------------------------------------------------
138## In one-liners without "{ ... }" body, the end-of-function is also
139## not correctly found:
140## Use C-M-e to see:  In these two, the "end-of-function" is after
141## 'class' :
142## ---- these all work now (ESS version 5.3.8) :
143## no it doesn't VS[10-03-2012|ESS 12.03]:
144onelinerFails <- function(x, ...) class(x)
145
146onelinerFailsToo <-
147    function(x, ...)
148        class(x)
149
150onelinerWorks <- function(x, ...) { class(x) }
151
152onelinerWorksToo <-
153    function(x, ...) {
154        class(x)
155    }
156
157### --- 7 ----------------------------------------------------------------
158## idem:
159## this has one line more before 'function' than "typically:"
160setMethod("[", signature(x = "dgTMatrix", i = "numeric", j = "missing",
161                         drop = "logical"),
162	  function (x, i, j, ..., drop) { ## select rows
163              storage.mode(i) <- "integer"
164              xi <- x@i + 1:1 # 1-indexing
165              ## ...................
166              if (drop && any(nd == 1)) drop(as(x,"matrix")) else x
167	  })
168
169### --- 8 ----------------------------------------------------------------
170## idem:
171## all bellow are ok VS[10-03-2012|ESS 12.03]:
172"dimnames<-.data.frame" <- function(x, value) {
173    d <- dim(x)
174    if(!is.list(value) || length(value) != 2
175       || d[[1]] != length(value[[1]])
176       || d[[2]] != length(value[[2]]))
177        stop("invalid 'dimnames' given for data frame")
178    row.names(x) <- as.character(value[[1]]) # checks validity
179    names(x) <- as.character(value[[2]])
180    x
181}
182
183'[.foo' <- function(x, i, value)
184{
185###
186    y <- x
187    y[i] <- value
188    y
189}
190
191'[[.bar' <- function(x, i, value)
192{
193    ## bla bla bla
194    y <- as.foo(x) ; y[[i]] <- value
195    y
196}
197
198"[<-.foobar" <- function(x,i,j,value) {
199    ## just something
200    x
201}
202
203"names<-.foobar" <- function(x, value) {
204    ## just something else
205    x
206}
207
208`[<-.data.frame` <- function(x, i, j, value)
209{
210    nA <- nargs() # value is never missing, so 3 or 4.
211
212###..........
213
214    class(x) <- cl
215    x
216}
217
218"[[<-.data.frame"<- function(x, i, j, value)
219{
220    cl <- oldClass(x)
221    ## delete class: Version 3 idiom
222    ## to avoid any special methods for [[<-
223    class(x) <- NULL
224
225###...........
226
227    class(x) <- cl
228    x
229}
230
231
232"$<-.data.frame" <- function(x, i, value)
233{
234    cl <- oldClass(x)
235    ## delete class: Version 3 idiom
236    ## to avoid any special methods for [[<-
237
238###...........
239
240    class(x) <- cl
241    return(x)
242}
243
244## swanky functions:
245`swank:quit-inspector` <- function(slimeConnection, sldbState) {
246    resetInspector(slimeConnection)
247    FALSE
248}
249
250'swank:quit-inspector' <- function(slimeConnection, sldbState) {
251    resetInspector(slimeConnection)
252    FALSE
253}
254
255
256### --- 9 ----------------------------------------------------------------
257## VS[03-2012|12.03]:FIXED:
258
259## From: "Sebastian P. Luque" <spluque@gmail.com>
260## To: ess-bugs@stat.math.ethz.ch
261## Subject: [ESS-bugs] ess-mode 5.12; `ess-indent-line' error
262## Date: Tue, 17 Aug 2010 13:08:25 -0500
263
264## With the following input, and point on the line with "Table 8.3":
265## it was the parenthetical expression at the beg of line
266
267if (require(lme4)) {
268    ## Model in p. 213
269    (fm1 <- lmer(logFEV1 ~ age + log(height) + age0 + log(height0) + (age | id),
270                 data=fev1, subset=logFEV1 > -0.5))
271    ## Table 8.3
272    VarCorr(fm1)$id * 100
273
274    ## Model in p. 216
275    (fm2 <- update(fm1, . ~ . - (age | id) + (log(height) | id)))
276}
277
278### -----
279## hitting TAB (`ess-indent-command'), which calls `ess-indent-line' I get
280## the following trace:
281
282## ....: (scan-error "Containing expression ends prematurely" 20 20)
283##   scan-sexps(177 -2)
284##   forward-sexp(-2)
285##   ...
286##   ess-continued-statement-p()
287## ......
288
289## Interestingly, if the lines 2-4 are absent, then the problem is gone.
290## The problem is also there in ESS 5.11.
291
292## I'll try to find out what is going on in `ess-continued-statement-p' but
293## given that I'm not very familiar with the stuff in ess-mode.el, I'm
294## submitting the report in case somebody can detect the issue sooner.
295
296## another example: hitting Tab at }else line
297.essDev_differs <- function(f1, f2){
298    if (is.function(f1) && is.function(f2)){
299        !(identical(body(f1), body(f2)) && identical(args(f1), args(f2)))
300    }else
301        !identical(f1, f2)
302}
303
304
305
306### --- 10 ---------------------------------------------------------------
307## indent at 0 after }else:
308## VS:[03-2012|12.03]:FIXED:
309if (is.function(f1) && is.function(f2)){
310    !(identical(body(f1), body(f2)) && identical(args(f1), args(f2)))
311}else
312    !identical(f1, f2)
313
314
315### --- 11 ---------------------------------------------------------------
316##  --------------- C-c C-c  was finding the wrong "beginning of function"
317##				[:FIXED:, 2011-05-28]
318foobar <- function(...) {}
319rm(list=ls())
320
321##--------> consequence of the above experiments:
322## the 2nd form is numerically "uniformly better" than the first
323##--------> 2011-05-27:  Change Frank's psiInv() to
324## psiInv = function(t,theta)
325##     -log1p(exp(-theta)*expm1((1-t)*theta)/expm1(-theta))
326
327### --- 12 ---------------------------------------------------------------
328##--- In the following block, in the first line, C-c C-c does *NOT* behave
329## VS[10-03-2012|ESS 12.03]: works fine for me:
330th <- 48 # now do ls() and see what happened ... the horror !!!
331d <- 3
332cpF <- list("Frank", list(th, 1:d))
333cop <- acF <- cpF$copula
334
335### --- 13 ---------------------------------------------------------------
336## VS[05-05-2012|ESS 12.04]: looks like :FIXED:
337
338## From: Aleksandar Blagotic <aca.blagotic@gmail.com>
339## To: <ess-help@stat.math.ethz.ch>
340## Subject: [ESS] R-mode: forward-sexp: Scan error: "Unbalanced parentheses"
341## Date: Tue, 6 Dec 2011 01:24:11 +0100
342                                        #
343## Let's presuppose that I have a function like this:
344                                        #
345fn <- function(x, ...){
346    re <- "^#{1,6} [[:print:]]+$"
347    grepl(re, x, ...)
348}
349## As soon as I put my cursor at the end of the line with regexp, and
350## press RET, I get this error:
351
352## forward-sexp: Scan error: "Unbalanced parentheses"
353##
354##-------
355## Rodney S: I can reproduce it ...
356## Martin M: I can NOT reproduce it, neither with 'emacs -Q';
357##	tried both ESS 5.14 and ESS from svn
358## VS[03-2012|12.03]: Cannot reproduce it either, solved?
359
360
361### --- 14 ---------------------------------------------------------------
362## check the behavior of ess-arg-function-offset-new-line
363
364a <- some.function(
365    arg1,
366    arg2)
367##  ^--- RRR has ess-arg-function-offset-new-line (4)  ==> should indent here
368
369a <- some.function(arg1,
370                   arg2)
371##                 ^--- here
372
373
374### --- 15 --------------------------------------------------------------
375## VS[05-05-2012|ESS 12.04]:FIXED:
376## indentation of the 3rd line is wrong
377for(s in seq(10, 50, len = 5))
378    for(a in seq(.5, 1, len = 5))
379        pt_dif_plot(s, a)
380##      ^-- here
381
382### --- 16 ----
383## VS[05-05-2012|ESS 12.04]:FIXED:
384## MM[2014-04-28]: added '}' before else (=> "{" after if(.))
385## so parse(<file>) works at all!
386## Gives error unbalanced para at else lines and indentation is wrong
387## error: Point is not in a function according to 'ess-function-pattern'.
388getOrCreateForm <- function(bindName, whereEnv)
389    if(exists(bindName, envir = get(".forms", envir = whereEnv))) {
390        get(bindName, envir = whereEnv)
391###      ^-- here
392    } else
393        new("protoForm")
394###     ^-- here
395
396
397
398parentContainer <-
399    if(is.null(.getPrototype(.Object@host))) { emptyenv()
400    } else sdf
401### ^-- here
402
403parentContainer <-
404    if(is.null(.getPrototype(.Object@host))) emptyenv()
405    else sdf
406### ^-- here
407
408### --- 17 ---
409## Indentation -----  "expression" is special
410expremmion <- c(1, 3,
411                9876)# was always ok
412## Had wrong indentation here:
413expression <- c(2343,
414                23874, 239487)
415
416## or here:
417foo <- function(x) {
418    expression <- c(2343,
419                    23874, 239487)
420    10 + expression
421}
422
423## Where as here, we *do* want the indentation to
424## *NOT* go all the way to the right:
425
426{
427    my.long.Expression <- expression(
428        x[a[j]] == exp(theta[1] + theta[2]^2),
429        x[b[i]] == sin(theta[3] ~~ theta[4])
430    )
431    ausdruck <- expression
432    my.long.Expr...... <- ausdruck(
433        x[a[j]] == exp(theta[1] + theta[2]^2),
434        )
435}
436
437## VS[18-08-2012]: redundant feature. This is a feature for long subexpressions
438## imidiately folowing new line. Documented in ess-arg-function-offset-new-line
439
440### --- 18 ---
441##  M-C-a (beginning of function)
442##  -----   anywhere inside the following function, M-C-a must go to beginning
443Ops.x.x <- function(e1, e2)
444{
445    d <- dimCheck(e1,e2)
446    if((dens1 <- extends(c1 <- class(e1), "denseMatrix")))
447	gen1 <- extends(c1, "generalMatrix")
448    if((dens2 <- extends(c2 <- class(e2), "denseMatrix")))
449	gen2 <- extends(c2, "generalMatrix")
450    if(dens1 && dens2) { ## both inherit from ddense*
451	geM <- TRUE
452	if(!gen1) {
453	    if(!gen2) { ## consider preserving "triangular" / "symmetric"
454		geM <- FALSE
455		le <- prod(d)
456		isPacked <- function(x) length(x@x) < le
457            }
458        }
459	## now, in all cases @x should be matching & correct {only "uplo" part is used}
460	r <- callGeneric(e1@x, e2@x)
461	if(geM)
462	    new(paste0(.M.kind(r), "geMatrix"), x = r, Dim = d, Dimnames = dimnames(e1))
463	else
464	    new(paste0(.M.kind(r), Mclass), x = r, Dim = d, .....)
465    }
466    else {
467	r <- ....
468
469	## criterion "2 * nnz(.) < ." as in sparseDefault() in Matrix()	 [./Matrix.R] :
470	if(2 * nnzero(r, na.counted = TRUE) < prod(d))
471	    as(r, "sparseMatrix") else r
472    }
473}
474
475
476### --- 19 ---
477## indentation with regexp (bug in ess-backward-to-noncomment)
478parse_roc <- function(lines, match = "^\\s*+\' ?") {
479    lines <- lines[str_detect(lines, match)]
480    if (length(lines) == 0) return(NULL)
481### ^-- here (2014-11: fixed)
482}
483
484
485### --- 20 ---
486## continuation indentation must be consistent in/out {}:
487
488{
489    a <- ggplot(data = overtime.by.month,
490                aes(x="", y=Percent, fill = Overtime)) +
491        geom_bar(width = 1) +
492        xlab('') +
493        ylab(sub.txt) +
494        labs(title = title.txt) +
495        facet_wrap(~Year.Month)
496}
497
498a <- ggplot(data = overtime.by.month,
499            aes(x="", y=Percent, fill = Overtime)) +
500    geom_bar(width = 1) +
501    xlab('') +
502    ylab(sub.txt) +
503    labs(title = title.txt) +
504    facet_wrap(~Year.Month)
505###                 ^-- face_wrap must be here
506
507
508### --- 20b ---
509## From https://github.com/emacs-ess/ESS/issues/120
510
511mean(rnorm(100, mean = runif(1, 1, 10)), na.rm =TRUE) +
512    2
513##  ^--- 2 is here
514
515mean(rnorm(100, mean = runif(1, 1, 10)),
516     na.rm =TRUE) +
517    2
518##  ^--- 2 is here
519
520mean(rnorm(100,
521           mean = runif(1, 1, 10)), na.rm=TRUE) +
522    2
523##  ^--- 2 is here
524
525### --- 21 ---
526
527## From: Marius Hofert <marius.hofert@math.ethz.ch>
528##     Date: Fri, 15 Mar 2013 21:00:45 +0100
529## Hi,
530## The following bug happens in ESS 12.09-2 [rev. 5395 (2013-01-10)]. Put the
531## cursor in the line before the function head and hit C-c C-c.
532
533foo <- function(x)
534    x # bar
535x <- 1:10
536
537## I'll see
538## > + >  [1]  1  2  3  4  5  6  7  8  9 10
539## ESS 15.03: Error in eval(expr,  ....  : object 'x' not found
540
541foo <- function(x) x*x
542bar <- function(y) y
543## via C-c C-c leads to "Error: object 'bar' not found". -- fixed
544
545
546### --- 22 ----
547## now correct indentation (inspite of # {was same reason as 19})
548if (!grepl("#", x))
549    return(res)
550
551### --- 23 ----
552### three ways to indent closing parent depending on context:
553foo <-
554    function_call(
555        a,
556        b,
557        c
558    )
559### ^-- ) is here now
560
561foo <- function_call(
562    a,
563    b,
564    c
565)
566### ")" is at column 0
567
568foo <- function_call(a,
569                     b,
570                     c
571                     )
572###                  ^-- ) is here
573
574### --- 24 ---
575### shift comma in function calls
576
577foo <- function_call(a
578                   , b
579                   , c
580###                  ^-- c is here
581                     )
582###                  ^-- ) is here
583
584### --- 25 ---
585## if/else in function calls and nested
586
587function_call(abc =
588                  if (test)
589                      do_something
590                  else
591                      do_something_else)
592
593function_call(
594    abc =
595        if (test)
596            do_something
597        else
598            do_something_else)
599
600
601function_call(abc = if (test)
602                        do_something
603                    else
604                        do_something_else)
605
606## real example is smooth.spline() source code [still (2015-04-08) wrong / bug!]
607ss <- function (x, all.knots, nknots, ...)
608{
609    if (all.knots) {
610        if (!missing(nknots) && !is.null(nknots))
611            warning("'all.knots' is TRUE; 'nknots' specification is disregarded")
612        nknots <- nx
613    } else if (is.null(nknots))         # <- for back compatibility
614        nknots <- .nknots.smspl(nx)
615    else {
616### ^ want 'else' there
617        if (is.function(nknots))
618            nknots <- nknots(nx)
619        else if (!is.numeric(nknots))
620            stop("'nknots' must be numeric (in {1,..,n})")
621        if (nknots < 1)
622            stop("'nknots' must be at least 1")
623        else if (nknots > nx)
624            stop("cannot use more inner knots than unique 'x' values")
625    }
626### ^-- want '}' there
627}
628
629## "if" conditional is an exception of the continuation rules:
630## Here, we do not want subsequently further indentation of the c1 || c2 || c3
631## part:
632t2 <- function(x) {
633    if(long.expression.of.some.size(x, pi) ||
634       another.longish.expression(sin(x)*exp(x)) ||
635       a.third.condition.under.which.A.is.chosen)
636###    ^-- here
637        A
638    else
639        B
640}
641
642
643r <-
644    (some.function (x, 2342)  +
645     another.f (x^3) + sdfsdf - sdfsdf  +
646     and(x) +  the(x) -  last(x)*part(3))
647
648
649### --- 26 ----
650## This is formally correct R, though help(parse) mentions the line-length limit of
651##  4095 __when reading from the console__
652## ESS gives syntax errors ("Error: unexpected ','" ...) when evaluating this
653## because line length >= 4096 :
654##
655x <- c(1, 3.075819, 1.515999, 2.156169, 1.480742, 1.765485, 1.460206, 1.603707, 1.427429, 1.504712, 1.334528, 1.48297,  1.355308, 1.383867, 1.319241, 1.36065,  1.307467, 1.365596, 1.255259, 1.352741, 1.239381, 3.15342, 1.799889, 2.258497, 1.688312, 1.906779, 1.548203, 1.724785, 1.500873, 1.573442, 1.417137, 1.540805, 1.395945, 1.472596, 1.394247, 1.377487, 1.337394, 1.369354, 1.333378, 1.3181, 1.313813, 1.315528, 2.12777, 2.718898, 1.993509, 2.220433, 1.820585, 1.97782, 1.672455, 1.770151, 1.587478, 1.685352, 1.539295, 1.584536, 1.499487, 1.50702, 1.41952, 1.449058, 1.393042, 1.432999, 1.369964, 1.400997, 1.333824, 2.950549, 2.145387, 2.382224, 1.927077, 2.032489, 1.8371, 1.877833, 1.710891, 1.756053, 1.620778, 1.657761, 1.558978, 1.56257, 1.508633, 1.534406, 1.46709, 1.468734, 1.432529, 1.455283, 1.386975, 1.417532, 2.229573, 2.494447, 2.016117, 2.190061, 1.877996, 1.978964, 1.767284, 1.836948, 1.677372, 1.743316, 1.616383, 1.655964, 1.55484, 1.594831, 1.502185, 1.543723, 1.467005, 1.491123, 1.44402, 1.446915, 1.401578, 2.580264, 2.109121, 2.240741, 1.944719, 2.043397, 1.821808, 1.89725, 1.748788, 1.786988, 1.659333, 1.697012, 1.610622, 1.616503, 1.538529, 1.562024, 1.499964, 1.529344, 1.474519, 1.483264, 1.441552, 1.434448, 2.165233, 2.320281, 2.007836, 2.086471, 1.884052, 1.950563, 1.76926, 1.843328, 1.708941, 1.741039, 1.627206, 1.644755, 1.580563, 1.593402, 1.527312, 1.568418, 1.501462, 1.502542, 1.464583, 1.467921, 1.431141, 2.340443, 2.048262, 2.161097, 1.926082, 1.995422, 1.81446, 1.853165, 1.738533, 1.784456, 1.679444, 1.696463, 1.612931, 1.629483, 1.548186, 1.580026, 1.52198, 1.531111, 1.482914, 1.484824, 1.442726, 1.447838, 2.093386, 2.185793, 1.948989, 2.02804, 1.867137, 1.907732, 1.771923, 1.800413, 1.691612, 1.720603, 1.642705, 1.649769, 1.589028, 1.598955, 1.539759, 1.55096, 1.503965, 1.50703, 1.471349, 1.469791, 1.436959, 2.218315, 1.997369, 2.041128, 1.887059, 1.928524, 1.79626, 1.827538, 1.716748, 1.735696, 1.658329, 1.664211, 1.599286, 1.611511, 1.553925, 1.562637, 1.516805, 1.529894, 1.476064, 1.482474, 1.453253, 1.458467, 2.0247, 2.07899, 1.921976, 1.949376, 1.824629, 1.851671, 1.744713, 1.765647, 1.683525, 1.685592, 1.625113, 1.624961, 1.571921, 1.581223, 1.535257, 1.537464, 1.497165, 1.504879, 1.468682, 1.469319, 1.448344, 2.092315, 1.941412, 1.969843, 1.844093, 1.866133, 1.766145, 1.783829, 1.703613, 1.709714, 1.646078, 1.654264, 1.594523, 1.598488, 1.545105, 1.555356, 1.514627, 1.521353, 1.483958, 1.487677, 1.449191, 1.459721, 1.958987, 1.985144, 1.87739, 1.879643, 1.786823, 1.799642, 1.720015, 1.724688, 1.663539, 1.662997, 1.609267, 1.615124, 1.56746, 1.562026, 1.520586, 1.52503, 1.493008, 1.502496, 1.471983, 1.468546, 1.435064, 1.994706, 1.880348, 1.894254, 1.805827, 1.815965, 1.744296, 1.743389, 1.665481, 1.681644, 1.624466, 1.626109, 1.584028, 1.5818, 1.54376, 1.547237, 1.504878, 1.515087, 1.479032, 1.47936, 1.450758, 1.45073, 1.892685, 1.91087, 1.825301, 1.827176, 1.745363, 1.746115, 1.693373, 1.701692, 1.648247, 1.637112, 1.594648, 1.592013, 1.554849, 1.55013, 1.522186, 1.520901, 1.492606, 1.493072, 1.460868, 1.46733, 1.440956, 1.92771, 1.835696, 1.841979, 1.775991, 1.766092, 1.703807, 1.708791, 1.654985, 1.655917, 1.602388, 1.611867, 1.570765, 1.573368, 1.53419, 1.529033, 1.506767, 1.503596, 1.481126, 1.471806, 1.444917, 1.451682, 1.850262, 1.855034, 1.778997, 1.789995, 1.718871, 1.717326, 1.667357, 1.666291, 1.619743, 1.631475, 1.582624, 1.58766, 1.546302, 1.545063, 1.512222, 1.517888, 1.489127, 1.487271, 1.466722, 1.463618, 1.444137, 1.8709, 1.794033, 1.80121, 1.736376, 1.740201, 1.673776, 1.682541, 1.638153, 1.642294, 1.604417, 1.597721, 1.559534, 1.559108, 1.533942, 1.529348, 1.499517, 1.501586, 1.473147, 1.473031, 1.457615, 1.452348, 1.805753, 1.812952, 1.746549, 1.747222, 1.696924, 1.694957, 1.652157, 1.650568, 1.607807, 1.613666, 1.577295, 1.570712, 1.543704, 1.538272, 1.515369, 1.517113, 1.487451, 1.491593, 1.464514, 1.464658, 1.439359, 1.823222, 1.758781, 1.767358, 1.70872, 1.712926, 1.666956, 1.667838, 1.62077, 1.621445, 1.592891, 1.58549, 1.55603, 1.559042, 1.521501, 1.523342, 2, 3, 4)
656
657### --- 27 ----
658## Indentation after open brace
659.a.lst <-
660    list(ex1 = function(p) {
661        cMah <- qchisq(0.975, p)
662        function(d) as.numeric(d < cMah)
663###     ^--- now here (less indented than prev.)
664    },
665    ex2 = function(p) {
666        cM <- qchisq(0.95, p)
667        function(d) as.numeric(d < cM)
668###     ^--- here
669    })
670### ^--- '}' here
671
672
673.a.lst <- list(ex1 = function(p) {
674    cMah <- qchisq(0.975, p)
675    function(d) as.numeric(d < cMah)
676}, ## <- now at column 0 {also the next line}
677ex2 = function(p) {
678    cM <- qchisq(0.95, p)
679    function(d) as.numeric(d < cM)
680})
681
682
683.a.lst <- list(list(aa = {
684    bbb
685### ^--- here
686},
687aaa = function(p) {
688    qchisq(0.95, p)
689### ^--- here
690},
691aaaa = {
692    cccc
693### ^--- here
694}))
695
696list(function(p){
697    abc
698### ^-- here
699    ## <-- Press [Tab] before/at the first '#': should *NOT* insert '...='
700})
701### at column 0
702
703(ab) {
704    sfdsf
705### ^-- here
706}
707
708### --- 27b --- [new, 2015-04-09]
709print.MethodsFunction <- function(x, byclass = attr(x, "byclass"), ...)
710{
711    info <- attr(x, "info")
712    values <- if (byclass) {
713                  unique(info$generic)
714              } else {
715                  visible <- ifelse(info$visible, "", "*")
716                  paste0(rownames(info), visible)
717###               ^-- both lines above should start here
718              }
719###           ^-- "}" here
720
721    ## 2nd version:
722    val <-
723        if (byclass) {
724            unique(info$generic)
725        } else {
726            visible <- ifelse(info$visible, "", "*")
727            paste0(rownames(info), visible)
728###         ^-- both lines above should start here
729        }
730###     ^-- "}" here
731    invisible(x)
732}
733
734
735
736### --- 28 --- [2015-02-17; still unfixed, 2015-11-21]
737## Indentation of end-line comments (to column 40 = 'indent-column')
738## {this is part of "real" code in Rmpfr/R/hjk.R}:
739hjk <- function(x,n) { # <--- C-M-q  "on {" -- does *no longer* indent the "# .."
740    ##-- Setting steps and stepsize -----
741    nsteps <- floor(log2(1/tol))	# number of steps
742    steps  <- 2^c(-(0:(nsteps-1))) # decreasing step size
743    dir <- diag(1, n, n) # orthogonal directions
744
745    x <- par    # start point
746    fx <- f(x)    # smallest value so far
747    fcount <- 1     # counts number of function calls
748
749    if (info) cat(sprintf("step  nofc %-12s | %20s\n",
750                          "fmin", "xpar"))
751
752    ##-- Start the main loop ------------
753    ns <- 0
754    while (ns < nsteps && fcount < maxfeval && abs(fx) < target) {
755        ns <- ns + 1
756        hjs    <- .hjsearch(x, f, steps[ns], dir, fcount, maxfeval, target)
757    }
758    hjs
759}
760
761### --- 29 ---
762foreach(a = 1:3) %do% {
763    a^2
764### ^--- here
765}
766
767foreach(a = 1:3) %:%
768    foreach(b = 10:13) %dopar% {
769### ^--- here
770        a + b
771###     ^---- here
772    }
773### ^--- here
774
775read.csv('file.csv') %>%
776    mutate(X = X+2, Y = Y/2) %>%
777### ^--- here
778    filter(X < 5)
779### ^-- here (*was* indented earlier)
780
781
782### --- 30 ---
783## a) ok:
784{
785    r <- array(if (d[3L] == 3L)
786                   rgb(t(x[,,1L]), t(x[,,2L]), t(x[,,3L]), maxColorValue = max)
787               else if (d[3L] == 4L)
788                   rgb(t(x[,,1L]), t(x[,,2L]), t(x[,,3L]), t(x[,,4L]), maxColorValue = max)
789               else stop("foo"),
790               dim = d[1:2])
791}
792
793## b) ok :
794{
795    obj <- obj && (condition1 || class2 %in% .BasicClasses ||
796                   condition3)
797}
798
799## c) ok:
800{
801    if (any(abs(d) < .001*abs(dd) |
802            (is.na(d) & x == y)))
803        TRUE
804}
805
806
807### --- 31 --------
808## C-s "recog"; M-C-a -- should go to beginning of function, does not
809
810glmmTMB <- function (formula, data = NULL)
811{
812    ## glFormula <- function(formula, data=NULL, family = gaussian,
813    ##                       subset, weights, na.action, offset,
814    ##                       contrasts = NULL, mustart, etastart,
815    ##                       control = glmerControl(), ...) {
816
817    ## FIXME: check for offsets in ziformula/dispformula, throw an error
818
819    call <- mf <- mc <- match.call()
820
821    if (is.null(family$family)) {
822        print(family)
823        stop("'family' not recognized")
824    }
825}
826
827
828### --- 32 --- 2015-11-07 --- indentation again! --------
829{
830    yl <- if(strictlim) {
831              ylim
832          }
833          else {
834              range(y, ylim)
835          }
836    ## room below for weights
837    dy <- 4*dy
838}
839## -- 32 b)
840{
841    yl <- if(strictlim) {
842              ylim
843          }
844          else
845              range(y, ylim)
846    ## continue
847}
848## -- 32 c)
849{
850    U <- if(is.matrix(x))
851             apply(x, 2, foo) / (nrow(x) + 1)
852         else
853             foo(x) / (length(x) + 1)
854}
855## 'else' now aligns with 'if' (and their code too)
856
857### --- 33 -- Treat `<<-` as `<-`
858{
859    f(X <-
860          callme(arg))
861    f(X <<-
862          callme(arg))
863}
864## the 2nd callme() now indents like the first
865
866
867### --- 34 ---  "eval-function" (e.g. C-c C-c) fails with this
868
869##' checking pretty():
870chkPretty <- function(x, n = 5, min.n = NULL, ..., max.D = 1) {
871    if(is.null(min.n)) {
872	## work with both pretty.default() and greDevices::prettyDate()
873	## *AND* these have a different default for 'min.n' we must be "extra smart":
874	min.n <-
875	    if(inherits(x, "Date") || inherits(x, "POSIXt"))
876		n %/% 2 # grDevices:::prettyDate
877	    else
878		n %/% 3 # pretty.default
879    }
880    pr <- pretty(x, n=n, min.n=min.n, ...)
881    ## if debugging: pr <- grDevices:::prettyDate(x, n=n, min.n=min.n, ...)
882    stopifnot(length(pr) >= (min.n+1),
883	      abs(length(pr) - (n+1)) <= max.D,
884              ## must be equidistant [may need fuzz, i.e., signif(.) ?]:
885	      length(pr) == 1 || length(unique(diff(pr))) == 1,
886	      ## pretty(x, *) must cover range of x:
887	      min(pr) <= min(x), max(x) <= max(pr))
888    invisible(pr)
889}
890
891
892### --- 35 ---  indentation of conditional function definitions:
893## from a robustbase vignette:
894{
895    ## calculate robustness weights
896    lwgts <- Mwgt(lresid, lctrl$tuning.psi, lctrl$psi)
897    ## function to calculate robustified leverages
898    tfun <-
899        if (is.function(attr(estlist$design, 'gen')))
900            function(i) {
901                if (all(is.na(wi <- lwgts[i,]))) wi
902                else .lmrob.hat(lXs[,,i,lcdn[2]],wi)
903            }
904    else
905###     \-<-- 'else' (and all below) should indent 4 more,  'else' matching the above 'if'
906        function(i) {
907            if (all(is.na(wi <- lwgts[i,]))) wi else .lmrob.hat(lX, wi)
908        }
909}
910
911### --- 36 --- indentation of '#' inside string plus a '#' after that, issue #446
912A <- f("abc") +
913    f("abc") + f("abc") +
914    f("abc # abc") +
915    ## The above is now ok,
916    f("abc # abc") +     # <- comment w/o quotes or hashtag -- fixed now: next line was indented to beginning of line
917    f("ABCDEF") +
918    f(g(h("abc # def"), "foo ## bar")) +
919    f("another")
920
921
922### --- 37 ----------Github issue #432 ---- now fixed
923## Indentation after string with "*"
924fo4 <- function(x, ...) {
925    if(length(x) > 0)
926        warning("Result gave strings of *different* #{characters}")
927    x
928    ## 'x' was wrongly indented --here: ^
929}
930
931### --- 38 ----------Mario Bouguin to ESS-bugs, Nov 21, 2017 ----
932scored <- read.csv(scored_path, comment.char="#")
933## writes
934## When I'm on the line and execute ess-eval-region-or-function-or-paragraph-and-step (i.e. C-c C-c), R only receives this:
935##
936## > scored <- read.csv(scored_path, comment.char="
937## +
938## MM: but I don't see this, so told him to upgrade ESS (he had 16.10, Windows)
939
940
941## This is a problem only inside package code [ess-tracebug related]
942rm(old,new)
943old <- 10    # line 1, use ess-eval-line,          i.e., C-c C-j
944new <- old+1 # line 2, use ess-eval-line-and-step, i.e., C-c C-n
945
946
947
948
949### Local Variables:
950### page-delimiter: "^### --- [1-9]"
951### End:
952