[R] A question about logical controls and function arguements

[Jason Q McClintic]

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")}
}