[Rd] Problem with match.arg() (PR#536)

kjetikj@astro.uio.no kjetikj@astro.uio.no
Sun, 7 May 2000 13:58:23 +0200 (MET DST)


Full_Name: Kjetil Kjernsmo
Version: Version 1.0.0
OS: osf1
Submission from: (NULL) (129.240.28.227)


Hello again!

This is a follow-up to my message on R-help about a problem with match.arg()
I have a little more on the topic, but not much really. 

First, it was not entirely true what I wrote in r-help that I call match.arg()
in my ramp(), because ramp() just calls qamp() with runif() as argument, but 
I have found that it happens both in ramp() and qamp().

Last night, just before I went home, R crashed with a segmentation fault. 
Unfortunately, I had limit coredumpsize 0, because I seldom want core-files,
so I haven't got it. I have removed that limit now. I have not been able to 
reproduce the crash, however.

Now, for a
> last.dump
$"apply(cbind(rep(1e+05, 25000)), 1, lineprofile, 10, 100, 1, "point")"
<environment: 140e187f0>

$"FUN(newX[, i], ...)"
<environment: 1404b6608>

$"apply(cbind(-as.integer(numberofbins/2):as.integer(numberofbins/2)), "
<environment: 1404b5460>

$"FUN(newX[, i], ...)"
<environment: 1400f6798>

$"photonsdetectedbin(ncb, intensityfromcloud(ncb, intensityfromcloud, "
<environment: 1400f55c8>

$"sum(rpois(ncloudsbin, sensitivity * intensityfromcloud))"
<environment: 1400f53e8>

$"rpois(ncloudsbin, sensitivity * intensityfromcloud)"
<environment: 1400f5168>

$"intensityfromcloud(ncb, intensityfromcloud, exptime, amptype)"
<environment: 1400f4c68>

$"ramp(ncloudsbin, amptype)"
<environment: 1400f4920>

$"qamp(runif(n), type)"
<environment: 1400ebdc0>

$"match.arg(type)"
<environment: 1400e97f0>

$"all(arg == choices)"
<environment: 140e2d740>

attr(,"error.message")
[1] "Error in arg == choices : comparison (1) is possible only for vector
types\n"
attr(,"class")
[1] "dump.frames"

I have also inserted some print statements at some places in the code. First:
qamp <- function(p,  type=c("point", "nolens"))
{
  print(c(2,type))
  type <- match.arg(type)
  if(type == "point")
    return(1 / (2 * sqrt(1 - p)))
  else return(1)
}
  
ramp <- function(n, type=c("point", "nolens"))
{
  print(c(1,type))
  type <- match.arg(type)
  if(type == "point")
    return(qamp(runif(n), type))
  else return(rep(1, n))
}
(I'll rewrite these to use switch eventually).

And, also in match.arg():
match.arg <- function (arg, choices) {
    if (missing(choices)) {
	formal.args <- formals(sys.function(sys.parent()))
	choices <- eval(formal.args[[deparse(substitute(arg))]])
    }
    print(c(2, arg, choices))
    if (all(arg == choices)) return(choices[1])
[...]
Upon running, I get
[1] "1"     "point"
[1] "point"  "point"  "nolens"
[1] "2"     "point"
[1] "point"  "point"  "nolens"
[thousands of these... :-) ]
[1] "1"     "point"
[1] "point"  "point"  "nolens"
[1] "2"     "point"
[1] "point"  "point"  "nolens"
[1] "1"     "point"
[1] "point"  "point"  "nolens"
[1] "2"     "point"
[1] "point"
Error in arg == choices : comparison (1) is possible only for vector types
So, suddenly, "choices" doesn't have a value, and consequently, the error.
FWIW, I have also printed formals(qamp)$type inside qamp, and it has the 
right value. 

Now, it seems hard to reproduce, I just did 100000 runs of ramp(10000, "point")

directly with no problems. In my code, ramp is called by a function that is
called
by a function, that is... :-) 

However, the code isn't very involved, really, so if you want to try, here it
is:
ncloudsbin <- function(binno, ntotalclouds, numberofbins = 100,
                       linewidth = numberofbins / 6)
  return(ntotalclouds * dnorm(binno, sd = linewidth))

intensityfromcloud <- function(ncloudsbin, cloudintensity, exptime, amptype)
  return(cloudintensity * exptime * ramp(ncloudsbin, amptype))

photonsdetectedbin <- function(ncloudsbin, intensityfromcloud,
                               continuumintensity, exptime, amptype,
                               sensitivity)
  return(sum(rpois(ncloudsbin, sensitivity * intensityfromcloud))
         + rgeom(1, 1 /(1 + (sensitivity * exptime * continuumintensity))))



lineprofile <- function(ntotalclouds, intensityfromcloud, continuumintensity,
                        exptime, amptype, sensitivity = 0.1, numberofbins =
100,
                        linewidth = numberofbins / 6)
{
  tf <- function(binno, ntotalclouds, intensityfromcloud, continuumintensity,
                 exptime, amptype, sensitivity, numberofbins, linewidth)
  {
    ncb <- ncloudsbin(binno, ntotalclouds, numberofbins, linewidth)
    return(photonsdetectedbin(ncb,
                   intensityfromcloud(
                            ncb, intensityfromcloud, exptime, amptype),
                   continuumintensity, exptime, amptype, sensitivity))
  }
  return(apply(cbind(-as.integer(numberofbins/2):as.integer(numberofbins/2)),
               1, tf,
               ntotalclouds, intensityfromcloud, continuumintensity,
               exptime, amptype, sensitivity, numberofbins, linewidth)) 
}

Note that "amptype" is here the "type" of the ?amp-functions. 
I call this by e.g. 
ll25000 <- apply(cbind(rep(100000, 25000)), 1, lineprofile, 10, 100, 1,
"point")


Just an idea: I have some problems in an entirely unrelated and more involved 
piece of code where it seems like sometimes, arguments are not returned from a 
function, that is, one variable of an object suddenly has no value. I haven't
really figured out if that is a bug of mine or in R, but could it be possible 
that something in
	formal.args <- formals(sys.function(sys.parent()))
	choices <- eval(formal.args[[deparse(substitute(arg))]])
doesn't get a value because there is an error in how objects are returned 
from a function?

BTW, I was exiting R (my ESS buffer was getting rather large), and I got the
following:
Save workspace image? [y/n/c]: y
Error: NewWriteItem: unknown type 17

Well, I guess this isn't much go on, but I know you are really good at this!
By running the above code, the error happens on every run here, it is just a
matter
of letting it run for long enough. I hope it is something to start on. I have a
few
more last.dumps on file too, if they are of use.

Kjetil

-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-devel mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-devel-request@stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._