Jason Q McClintic
2007-Jun-15 16:25 UTC
[R] A question about logical controls and function arguements
Dear R-help subscribers,
I'm trying to write a function to generate data simulating the image
created by a point radiation source in a plane on a screen where there
is filter with a single circular aperture in it between the source and
the screen.
Following some guides (including Intro to R and some I found online) and
examples I have specified the function (full code below question) with
several arguments with the form:
option=c("option1","option2")
For instance, I want filter to either be "FALSE" to tell the function
there is no filter or an ordered triplet describing the location and
radius of the area radiation is not blocked by the filter. There are
several others along similar lines.
When I source the function into R, it parses fine, but when attempting
to run it with
data.spect<-spect.data(source.p="r",filter=c(0,0,1),file.out="FALSE")
the following warning is returned:
Warning messages:
1: the condition has length > 1 and only the first element will be used
in: if (filter == "FALSE") {
2: the condition has length > 1 and only the first element will be used
in: if (filter == "FALSE") {
The code this is referencing is about 1/3 from the bottom of the function.
I'm not sure how to correct this. I tried ifelse in one case and it
doesn't work at all. Searching the archives for "function
arguments"
didn't yield anything about the kind of arguments that are causing the
trouble.
I also want to get the matrix of generated data out, and have tried
data.spect$final.sample (following an example I found online), but it
returns null. I also attempted to use data.spect$initial.sample, but
this returned null as well.
I'm still very new to writing my own functions, and any and all help
would be appreciated.
There are notes about what different options are supposed to do at the
end of the appended code.
Thanks in advance,
Jason Q McClintic
--
Jason Q McClintic
jqmcclintic at stthomas.edu
mccl0219 at tc.umn.edu
spect.data<-function(num.points=50,fixed=FALSE,source.p=c("r","c(0,0)"),
source.mean=0,source.sd=1,filter=c("FALSE","c(0,0,1)"),
heights=c(0.5,0.5),
file.out=c("FALSE","/home/jqmcclintic/Desktop/spect.data")){
##Determine Start Point
if (source.p=="r")
{source<-c(rnorm(1,source.mean,source.sd),rnorm(1,source.mean,source.sd))}
else {source<-source.p}
cat("The location of the source is: ",source,"\n")
##Generate the data
remainder<-num.points
initial.sample<-c(1,1)
##finds intersection points with the screen
intersect.screen.at<-function(x,h){
t<-h[1]/(2*cos(x))
x.intercept<-t*sin(x[,2])*cos(x[,1])
y.intercept<-t*sin(x[,2])*sin(x[,1])
}
##finds intersection points with the collecting plate
intersect.plate.at<-function(x,h){
t<-h[2]/(2*cos(x))
x.intercept<-t*sin(x[,2])*cos(x[,1])
y.intercept<-t*sin(x[,2])*sin(x[,1])
}
##determines if the intersection point is inside or outside the hole in
the screen. x is the matrix of intersection points and s is the location
and radius of the hole in the screen. 1 for yes, 0 for no.
passes.through<-function(x,s){
distance<-sqrt(((x[,1]-s[1])^2)+((x[,2]-s[2])^2))
through<-ifelse(distance<s[3],1,0)
}
##Build the sample
while (remainder>0){
##Generate n random vectors uniformly distributed over S2
theta<-runif(remainder,0,6.2831853)
phi<-runif(remainder,0,1.5707963)
theta.phi<-cbind(theta,phi)
initial.sample<-rbind(initial.sample,theta.phi)
##Call intersect.screen.at
intersects.screen<-intersect.screen.at(initial.sample,heights)
##Call intersect.plate.at
intersects.plate<-if(filter=="FALSE")
{intersect.screen.at(initial.sample,heights)} else {
intersect.plate.at(initial.sample,heights)
}
##Does it intersect inside or outside the hole?
intersect.hole<-if(filter=="FALSE"){array(1,dim=length(initial.sample))}
else{passes.through(intersects.screen,filter)}
##Remove points that do not pass throught the hole. By design, if
there is no filter, all pass through the hole.
initial.sample<-cbind(initial.sample,intersect.hole)
initial.sample<-subset(initial.sample,initial.sample[,3]==1)
##Reset remainder
remainder<-if(fixed=="FALSE") {0} else {
num.points-length(initial.sample)
}
}
write(initial.sample)
##remove the top row of the initial sample since it is non-random.
final.sample<-initial.sample[-1,]
##print the final sample to a csv file for archival purposes
if(file.out!="FALSE"){write.csv(final.sample,file=file.out);cat("The
location of the data is:",file.out,"\n")} else{cat("No csv
file
requested","\n")}
}
Jason Q McClintic
2007-Jun-15 17:01 UTC
[R] A question about logical controls and function arguements
Sir, I freely admit my ignorance as to the subtleties of specifying arguments. Let me make sure I understand your suggestion: create a variable filter which takes 1 or 0 (filter or not) and another called, say, filter.location which is the ordered triplet. It does add to the number of options, but would seem to simplify the underlying code. It appears I may have attempted to code above my skill level. Thanks for the assistance, Jason Q McClintic -- Jason Q McClintic jqmcclintic at stthomas.edu mccl0219 at tc.umn.edu jim holtman wrote:> You are trying to use 'filter' in two ways. Your code is testing for a > single value ("FALSE"), and that is all that "==" can do (single value), > but you are pass in a vector (c(0,0,1)) which has three values, on the > first of which can be tested by the "==". > > So you might want to consider having another parameter which says > whether or not to use "filter". > > >> On 6/15/07, *Jason Q McClintic* <jqmcclintic at stthomas.edu >> <mailto:jqmcclintic at stthomas.edu>> wrote: >> >> Dear R-help subscribers, >> >> I'm trying to write a function to generate data simulating the image >> created by a point radiation source in a plane on a screen where there >> is filter with a single circular aperture in it between the source and >> the screen. >> >> Following some guides (including Intro to R and some I found online) >> and >> examples I have specified the function (full code below question) with >> several arguments with the form: >> >> option=c("option1","option2") >> >> For instance, I want filter to either be "FALSE" to tell the function >> there is no filter or an ordered triplet describing the location and >> radius of the area radiation is not blocked by the filter. There are >> several others along similar lines. >> >> When I source the function into R, it parses fine, but when attempting >> to run it with >> >> data.spect<-spect.data(source.p="r",filter=c(0,0,1),file.out="FALSE") >> >> the following warning is returned: >> >> Warning messages: >> 1: the condition has length > 1 and only the first element will be used.> in: if (filter == "FALSE") { .> 2: the condition has length > 1 and only the first element will be used>> in: if (filter == "FALSE") {.>>> The code this is referencing is about 1/3 from the bottom of the >> function. >> >> I'm not sure how to correct this. I tried ifelse in one case and it >> doesn't work at all. Searching the archives for "function arguments" >> didn't yield anything about the kind of arguments that are causing the >> trouble. >> I also want to get the matrix of generated data out, and have tried >> data.spect$final.sample (following an example I found online), but it >> returns null. I also attempted to use data.spect$initial.sample , but >> this returned null as well. >> >> I'm still very new to writing my own functions, and any and all help >> would be appreciated. >> >> There are notes about what different options are supposed to do at the.> end of the appended code.>> >> Thanks in advance, >> >> Jason Q McClintic >> -- >> Jason Q McClintic >> jqmcclintic at stthomas.edu <mailto:jqmcclintic at stthomas.edu> >> mccl0219 at tc.umn.edu <mailto:mccl0219 at tc.umn.edu> >> >> spect.data<-function(num.points=50,fixed=FALSE,source.p=c("r","c(0,0)"), >> source.mean=0,source.sd=1,filter=c("FALSE","c(0,0,1)"), >> heights=c(0.5,0.5), >> file.out=c ("FALSE","/home/jqmcclintic/Desktop/spect.data")){ >> ##Determine Start Point >> if (source.p=="r") >> {source<-c(rnorm(1,source.mean,source.sd <http://source.sd> >> ),rnorm(1,source.mean,source.sd <http://source.sd>))} >> else {source<-source.p} >> cat("The location of the source is: ",source,"\n") >> ##Generate the data >> remainder<- num.points >> initial.sample<-c(1,1) >> ##finds intersection points with the screen >> intersect.screen.at >> <http://intersect.screen.at><-function(x,h){ >> t<-h[1]/(2*cos(x)) >> x.intercept<-t*sin(x[,2])*cos(x[,1]) >> y.intercept<-t*sin(x[,2])*sin(x[,1]) >> } >> ##finds intersection points with the collecting plate >> intersect.plate.at >> <http://intersect.plate.at><-function(x,h){ >> t<-h[2]/(2*cos(x)) >> x.intercept<-t*sin(x[,2])*cos(x[,1]) >> y.intercept <-t*sin(x[,2])*sin(x[,1]).> }>> ##determines if the intersection point is inside or outside >> the hole in >> the screen. x is the matrix of intersection points and s is the location >> and radius of the hole in the screen. 1 for yes, 0 for no. >> passes.through<-function(x,s){ >> distance<-sqrt(((x[,1]-s[1])^2)+((x[,2]-s[2])^2)) >> through<-ifelse(distance<s[3],1,0) >> } >> ##Build the sample >> while (remainder>0){ >> ##Generate n random vectors uniformly distributed over S2 >> theta<-runif(remainder,0,6.2831853) >> phi<-runif(remainder,0, 1.5707963) >> theta.phi<-cbind(theta,phi) >> initial.sample<-rbind(initial.sample,theta.phi) >> ##Call intersect.screen.at <http://intersect.screen.at> >> >> intersects.screen<-intersect.screen.at(initial.sample,heights) >> ##Call intersect.plate.at <http://intersect.plate.at> >> intersects.plate<-if(filter=="FALSE") >> {intersect.screen.at(initial.sample,heights)} else { >> intersect.plate.at(initial.sample,heights) >> } >> ##Does it intersect inside or outside the hole? >> >> intersect.hole >> <-if(filter=="FALSE"){array(1,dim=length(initial.sample))} >> else{passes.through(intersects.screen,filter)} >> ##Remove points that do not pass throught the hole. >> By design, if >> there is no filter, all pass through the hole. >> initial.sample<-cbind(initial.sample,intersect.hole) >> >> initial.sample<-subset(initial.sample,initial.sample[,3]==1) >> ##Reset remainder >> remainder<-if(fixed=="FALSE") {0} else { >> num.points-length(initial.sample) >> } >> } >> write(initial.sample) >> ##remove the top row of the initial sample since it is >> non-random. >> final.sample <-initial.sample[-1,] >> ##print the final sample to a csv file for archival purposes >> >> if(file.out!="FALSE"){write.csv(final.sample,file=file.out);cat("The >> location of the data is:", file.out,"\n")} else{cat("No csv file >> requested","\n")} >> } >> >> ______________________________________________ >> R-help at stat.math.ethz.ch <mailto:R-help at stat.math.ethz.ch> mailing list >> https://stat.ethz.ch/mailman/listinfo/r-help >> PLEASE do read the posting guide >> http://www.R-project.org/posting-guide.html >> <http://www.R-project.org/posting-guide.html> >> and provide commented, minimal, self-contained, reproducible code. >> >> >> >> >> -- >> Jim Holtman >> Cincinnati, OH >> +1 513 646 9390 >> >> What is the problem you are trying to solve?