/ContinuousDeletor.R

  1##	
  2## Copyright 2009 Botond Sipos	
  3## See the package description for licensing information.	
  4##	
  5##########################################################################/** 
  6#
  7# @RdocClass ContinuousDeletor
  8# 
  9# @title "The ContinuousDeletor class"
 10# 
 11# \description{ 
 12#	This class implements a process which performs deletions with
 13#       lengths sampled from a user-specified R expression returning a 
 14#	numeric value.
 15#       See \code{GeneralDeletor} for the how the deletion processes
 16#	works.
 17#
 18#	@classhierarchy
 19# }
 20#	
 21# @synopsis
 22#	
 23# \arguments{
 24# 	\item{name}{The name of the object.}
 25# 	\item{rate}{The general rate.}
 26# 	\item{dist}{The length sampling expression.}
 27# 	\item{max.length}{Maximum event length.}
 28# 	\item{...}{Additional arguments.}
 29#	}
 30# 
 31# \section{Fields and Methods}{ 
 32# 	@allmethods
 33# }
 34# 
 35# \examples{ 
 36# 	# create a ContinuousDeletor process
 37#       o<-ContinuousDeletor(
 38#               name="Conty",
 39#               rate=0.25,
 40#		dist=expression(1),
 41#		max.length=2
 42#       )
 43#       # get object summary
 44#       summary(o)
 45#       # set/get length sampling expression
 46#       o$dist<-expression(rnorm(1,mean=3,sd=3))
 47#	o$dist
 48#       # set/get maximum event length
 49#	o$maxLength<-4
 50#	o$maxLength
 51#       # plot length density
 52#       plot(o)
 53#       
 54#       # The following code illustrates how to use
 55#       # a ContinuousDeletor process in a simulation
 56#       
 57#       # create a sequence object, attach process o
 58#       s<-NucleotideSequence(string="AAAAAAAAAAGGGGAAAAAAAAAA",processes=list(list(o)))
 59#       # set the deletion tolerance to zero in range 11:15
 60#       # creating a region rejecting all deletions
 61#       setDeletionTolerance(s,o,0,11:15)       
 62#       # get deletion tolerances
 63#       getDeletionTolerance(s,o)
 64#       # create a simulation object
 65#       sim<-PhyloSim(root.seq=s,phylo=rcoal(2))
 66#       # simulate
 67#       Simulate(sim)
 68#       # print resulting alignment
 69#       sim$alignment
 70# }
 71# 
 72# @author
 73#
 74# \seealso{ 
 75# 	GeneralDeletor DiscreteDeletor GeneralInDel
 76# }
 77# 
 78#*/###########################################################################
 79setConstructorS3(
 80  "ContinuousDeletor",
 81  function( 
 82		name="Anonymous",
 83		rate=NA,
 84		dist=NA,
 85		max.length=NA,
 86		... 
 87		)	{
 88
 89		this<-GeneralDeletor(
 90			 name=NA,
 91			 rate=rate,
 92			 propose.by=NA,
 93    	 accept.by=NA,
 94			...
 95		);
 96    this<-extend(
 97      this,
 98      "ContinuousDeletor",
 99			.dist=NA,
100			.max.length=NA
101    );
102		# Using virtual field to clear Id cache:
103		this$name<-name;
104
105		STATIC<-TRUE;
106		if(!missing(dist)) {
107			this$dist<-dist;
108			STATIC<-FALSE;
109		}
110		
111		if(!missing(max.length)) {
112			this$.max.length<-max.length;
113			STATIC<-FALSE;
114		}
115
116		this$proposeBy<-function(process=NA,...){
117			if(!exists(x="PSIM_FAST")){
118				if(!is.expression(process$.dist)){
119					throw("\"dist\" is undefined, so cannot propose deletion length!\n");
120				}
121				else if(is.na(process$.max.length)){
122					throw("\"maxLength\" is undefined, so cannot propose deletion length!\n");
123				}
124			}
125				tmp<-round(eval(process$.dist));
126				while( tmp > process$.max.length | tmp < 1){  tmp<-round(eval(process$.dist)) };	
127				return(tmp);
128		}
129
130    return(this);
131  },
132  enforceRCC=TRUE
133);
134
135##	
136## Method: checkConsistency
137##	
138###########################################################################/**
139#
140# @RdocMethod	checkConsistency
141# 
142# @title "Check object consistency"
143# 
144# \description{ 
145#		@get "title".
146# } 
147# 
148# @synopsis 
149#
150# \arguments{ 
151#       \item{this}{An object.} 
152#       \item{...}{Not used.} 
153# } 
154# 
155# 
156# \value{ 
157#		Returns an invisible TRUE if no inconsistencies found in the object, throws 
158#		an error otherwise. 
159# } 
160# 
161# @author 
162# 
163# \seealso{ 
164# 	@seeclass 
165# } 
166# 
167#*/###########################################################################
168setMethodS3(
169  "checkConsistency",
170  class="ContinuousDeletor",
171  function(
172    this,
173    ...
174  ){
175
176      wp<-this$writeProtected;
177      if (wp) {
178        this$writeProtected<-FALSE;
179      }
180
181      may.fail<-function(this) {
182
183        if (!is.na(this$maxLength)) {
184          this$maxLength<-this$maxLength;
185        }
186
187        if (is.expression(this$dist)) {
188          this$dist<-this$dist;
189        }
190        else if (!is.na(this$dist)){
191          throw("Deletion length sampler expression is invalid!\n");
192        }
193
194      }
195      tryCatch(may.fail(this),finally=this$writeProtected<-wp);
196      NextMethod();
197
198  },
199  private=FALSE,
200  protected=FALSE,
201  overwrite=FALSE,
202  conflict="warning",
203  validators=getOption("R.methodsS3:validators:setMethodS3")
204);
205
206
207##	
208## Method: getDist
209##	
210###########################################################################/**
211#
212# @RdocMethod getDist
213# 
214# @title "Get the length sampling expression" 
215# 
216# \description{ 
217#	@get "title".
218#
219#	The length sampling expression can be any valid R expression returning
220#	a numeric vector of length one. The value returned by the expression will be 
221#	rounded.
222# } 
223# 
224# @synopsis 
225# 
226# \arguments{ 
227# 	\item{this}{A ContinuousDeletor object.} 
228# 	\item{...}{Not used.} 
229# } 
230# 
231# \value{ 
232# 	An R expression object.
233# } 
234# 
235# \examples{
236#	# create object
237#	o<-ContinuousDeletor(rate=1)
238#	# set/get length sampling expression
239#	setDist(o, expression(rnorm(1,mean=3, sd=2)))
240#	getDist(o)
241#	# set/get length sampling expression via virtual field
242#	o$dist<-expression(rnorm(1,mean=6,sd=3))
243#	o$dist
244#	# set maxLength
245#	o$maxLength<-10
246#	# propose a length
247#	proposeLength(o)
248# } 
249# 
250# @author 
251# 
252# \seealso{ 
253# 	@seeclass 
254# } 
255# 
256#*/###########################################################################
257setMethodS3(
258	"getDist", 
259	class="ContinuousDeletor", 
260	function(
261		this,
262		...
263	){
264
265		this$.dist;
266		
267	},
268	private=FALSE,
269	protected=FALSE,
270	overwrite=FALSE,
271	conflict="warning",
272	validators=getOption("R.methodsS3:validators:setMethodS3")
273);
274
275##	
276## Method: setDist
277##	
278###########################################################################/**
279#
280# @RdocMethod setDist
281# 
282# @title "Set the length sampling expression" 
283# 
284# \description{ 
285#	@get "title".
286#
287#	The length sampling expression can be any valid R expression returning
288#	a numeric vector of length one. The value returned by the expression will be 
289#	rounded.
290# } 
291# 
292# @synopsis 
293# 
294# \arguments{ 
295# 	\item{this}{A ContinuousDeletor object.} 
296# 	\item{value}{An R expression.} 
297# 	\item{...}{Not used.} 
298# } 
299# 
300# \value{ 
301# 	An R expression object.
302# } 
303# 
304# \examples{
305#	# create object
306#	o<-ContinuousDeletor(rate=1)
307#	# set/get length sampling expression
308#	setDist(o, expression(rnorm(1,mean=3, sd=2)))
309#	getDist(o)
310#	# set/get length sampling expression via virtual field
311#	o$dist<-expression(rnorm(1,mean=6,sd=3))
312#	o$dist
313#	# set maxLength
314#	o$maxLength<-10
315#	# propose a length
316#	proposeLength(o)
317# } 
318# 
319# @author 
320# 
321# \seealso{ 
322# 	@seeclass 
323# } 
324# 
325#*/###########################################################################
326setMethodS3(
327	"setDist", 
328	class="ContinuousDeletor", 
329	function(
330		this,
331		value,
332		...
333	){
334		
335		.checkWriteProtection(this);
336		if (missing(value)) {
337			throw("No new value provided!\n");
338		} 
339		else if (length(value) != 1 ) {
340			throw("Value vector size should be 1!\n");
341		}
342		else if(!is.expression(value)) {
343			throw("The new value must be a valid expression!\n");
344		} else {
345			# Do a test sampling:
346			tmp<-eval(value);
347			if( length(tmp) != 1 ) {
348				throw("The return value of the length sampler expression must be of length 1!\n");
349			}
350			if (!is.numeric(tmp)) {
351				throw("The return value of the length sampler expression must be numeric!\n");
352			}
353			else {
354				this$.dist<-value;
355			}
356		}
357		
358	},
359	private=FALSE,
360	protected=FALSE,
361	overwrite=FALSE,
362	conflict="warning",
363	validators=getOption("R.methodsS3:validators:setMethodS3")
364);
365
366##	
367## Method: getMaxLength
368##	
369###########################################################################/**
370#
371# @RdocMethod getMaxLength
372# 
373# @title "Get the maximum length" 
374# 
375# \description{ 
376#	@get "title".
377# } 
378# 
379# @synopsis 
380# 
381# \arguments{ 
382# 	\item{this}{A ContinuousDeletor object.} 
383# 	\item{...}{Not used.} 
384# } 
385# 
386# \value{ 
387# 	A numeric vector of length one.
388# } 
389# 
390# \examples{
391#	# create object
392#	o<-ContinuousDeletor(rate=1)
393#	# set length sampling expression via virtual field
394#	o$dist<-expression(rnorm(1,mean=6,sd=3))
395#	# set/get maxLength
396#	setMaxLength(o, 3)
397#	getMaxLength(o)
398#	# set/get maxLength via virtual field
399#	o$maxLength<-10
400#	o$maxLength
401#	# propose a length
402#	proposeLength(o)
403# } 
404# 
405# @author 
406# 
407# \seealso{ 
408# 	@seeclass 
409# } 
410# 
411#*/###########################################################################
412setMethodS3(
413	"getMaxLength", 
414	class="ContinuousDeletor", 
415	function(
416		this,
417		...
418	){
419
420		this$.max.length;
421		
422	},
423	private=FALSE,
424	protected=FALSE,
425	overwrite=FALSE,
426	conflict="warning",
427	validators=getOption("R.methodsS3:validators:setMethodS3")
428);
429
430##	
431## Method: setMaxLength
432##	
433###########################################################################/**
434#
435# @RdocMethod setMaxLength
436# 
437# @title "Set the maximum length" 
438# 
439# \description{ 
440#	@get "title".
441# } 
442# 
443# @synopsis 
444# 
445# \arguments{ 
446# 	\item{this}{A ContinuousDeletor object.} 
447#	\item{value}{A numeric (integer) vector of length one.}
448# 	\item{...}{Not used.} 
449# } 
450# 
451# \value{ 
452# 	The new maximum length.
453# } 
454# 
455# \examples{
456#	# create object
457#	o<-ContinuousDeletor(rate=1)
458#	# set length sampling expression via virtual field
459#	o$dist<-expression(rnorm(1,mean=6,sd=3))
460#	# set/get maxLength
461#	setMaxLength(o, 3)
462#	getMaxLength(o)
463#	# set/get maxLength via virtual field
464#	o$maxLength<-10
465#	o$maxLength
466#	# propose a length
467#	proposeLength(o)
468# } 
469# 
470# @author 
471# 
472# \seealso{ 
473# 	@seeclass 
474# } 
475# 
476#*/###########################################################################
477setMethodS3(
478	"setMaxLength", 
479	class="ContinuousDeletor", 
480	function(
481		this,
482		value,
483		...
484	){
485	
486		.checkWriteProtection(this);
487		if (missing(value)) {
488			throw("No new value provided!\n");
489		} 
490		else if (length(value) != 1 ) {
491			throw("Value vector size should be 1!\n");
492		}
493		else if (!is.numeric(value)) {
494			throw("Value vector size should be numeric!\n");
495		}
496		else if( round(value) != value ) {
497			throw("maxLength must be integer!\n");
498		} else {
499			this$.max.length<-value;
500		}
501		return(invisible(this$.max.length));
502		
503	},
504	private=FALSE,
505	protected=FALSE,
506	overwrite=FALSE,
507	conflict="warning",
508	validators=getOption("R.methodsS3:validators:setMethodS3")
509);
510
511##
512## Method: plot
513##
514###########################################################################/**
515#
516# @RdocMethod plot
517# 
518# @title "Plot the density of proposed lengths" 
519# 
520# \description{ 
521#	@get "title".
522# } 
523# 
524# @synopsis 
525# 
526# \arguments{ 
527# 	\item{x}{A ContinuousDeletor object.} 
528# 	\item{sample.size}{Number of lengths sampled for the plot.} 
529# 	\item{...}{Not used.} 
530# } 
531# 
532# \value{ 
533# 	The process object (invisible).
534# } 
535# 
536# \examples{
537#	# create object
538#	o<-ContinuousDeletor(rate=1)
539#	# set length sampling expression via virtual field
540#	o$dist<-expression(rnorm(1,mean=10,sd=4))
541#	# set maxLength
542#	setMaxLength(o, 30)
543#	# plot density
544#	plot(o)
545# } 
546# 
547# @author 
548# 
549# \seealso{ 
550# 	@seeclass 
551# } 
552# 
553#*/###########################################################################
554setMethodS3(
555  "plot",
556  class="ContinuousDeletor",
557  function(
558    x,
559    sample.size=NA,
560    ...
561  ){
562
563		this<-x;		
564		if( !is.numeric(this$maxLength) | !is.expression(this$dist) ){
565				warning("Deletion length distribution is not defined properly! Nothing to plot here!\n");
566				return();
567		}
568		size<-(this$maxLength * 10);
569		if(!missing(sample.size)){
570				if(!is.numeric(sample.size) | ( length(sample.size)) !=1 ) {
571					throw("Sample size paramter must be a numeric vector of size 1!\n");
572				} else {
573					size<-round(sample.size);
574				}
575		}
576
577			sample<-apply(as.array(0:size),1,function(...){this$.propose.by(this)});
578      plot.default(
579				density(sample,from=0,to=this$maxLength),
580        			main=paste("Estimated deletion size density for:",this$id),
581				sub=paste("Sample size:", size),
582				type='l',
583        			xlab="Size",
584        			ylab="Density",
585				xlim=c(1,this$maxLength),
586				col="blue",
587				lwd=1.5,
588				xaxt="n"
589      );
590			 axis(side=1, at=c(0:this$maxLength), labels=c(0:this$maxLength));
591			 return(invisible(this));
592
593  },
594  private=FALSE,
595  protected=FALSE,
596  overwrite=FALSE,
597  conflict="warning",
598  validators=getOption("R.methodsS3:validators:setMethodS3")
599);
600
601##
602## Method: summary
603##
604###########################################################################/**
605#
606# @RdocMethod summary
607#
608# @title "Summarize the properties of an object"
609#
610# \description{
611#       @get "title".
612# }
613#
614# @synopsis
615#
616# \arguments{
617#       \item{object}{An object}
618#       \item{...}{Not used.}
619# }
620#
621# \value{
622#  Returns a PSRootSummary object.
623# }
624#
625# \examples{
626#
627#       # create an object
628#       a<-ContinuousDeletor(rate=1,dist=expression(rnorm(1,mean=5,sd=3)), max.length=10)
629#       # get a summary
630#       summary(a)
631# }
632#
633# @author
634#
635# \seealso{
636#       @seeclass
637# }
638#
639#*/###########################################################################
640setMethodS3(
641  "summary",
642  class="ContinuousDeletor",
643  function(
644    object,
645    ...
646  ){
647    
648    this<-object;
649    .addSummaryNameId(this);
650
651    this$.summary$"Length sampling expression"<-deparse(this$dist);
652    this$.summary$"Maximum deletion length"<-this$maxLength;
653    NextMethod();
654
655  },
656  private=FALSE,
657  protected=FALSE,
658  overwrite=FALSE,
659  conflict="warning",
660  validators=getOption("R.methodsS3:validators:setMethodS3")
661);
662