/ContinuousDeletor.R

http://github.com/sbotond/phylosim · R · 662 lines · 239 code · 34 blank · 389 comment · 36 complexity · 8657b4e727b44b1a6beb7c81fb687ca1 MD5 · raw file

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