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
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._