Codebase list gtools / upstream/2.4.0
Import Upstream version 2.4.0 Dirk Eddelbuettel 5 years ago
9 changed file(s) with 347 addition(s) and 5 deletion(s). Raw diff Collapse all Expand all
+51
-0
ChangeLog less more
0 2007-08-08 13:48 warnes
1
2 * DESCRIPTION, NAMESPACE, NEWS, R/binsearch.R, man/binsearch.Rd:
3 Add the binsearch(), previously in the genetics package.
4
5 2007-07-18 11:48 ggorjan
6
7 * man/combinations.Rd: typo fixed
8
9 2007-04-12 21:16 warnes
10
11 * NAMESPACE, NEWS, R/ask.R, man/ask.Rd: Add ask() function to
12 prompt the user and collect a single response.
13
14 2007-04-07 13:41 warnes
15
16 * DESCRIPTION, R/mixedsort.R: Fix improper escapes in regexp
17 detected by R 2.5.0 package check.
18
19 2007-03-23 22:53 warnes
20
21 * R/combinations.R: Allow permutations for r>n provided
22 repeats.allowed=TRUE
23
24 2006-11-28 00:53 warnes
25
26 * man/smartbind.Rd: Replace F with FALSE in smartbind example.
27
28 2006-11-27 22:42 warnes
29
30 * man/smartbind.Rd: Replace T with TRUE in smartbind example
31
32 2006-11-27 21:40 warnes
33
34 * data/ELISA.rda: Temprary remove to reset binary flag
35
36 2006-11-27 21:40 warnes
37
38 * data/ELISA.rda: Temprary remove to reset binary flag
39
40 2006-11-27 21:34 warnes
41
42 * DESCRIPTION, NAMESPACE, NEWS, R/smartbind.R, man/smartbind.Rd:
43 Add smartbind() to list of exported functions, and add
44 corresponding
45 documentation file.
46
47 2006-11-27 20:52 warnes
48
49 * DESCRIPTION: Update my email address
50
051 2006-11-14 22:25 ggorjan
152
253 * trunk/gdata/man/combine.Rd, trunk/gdata/man/frameApply.Rd,
+2
-3
DESCRIPTION less more
00 Package: gtools
11 Title: Various R programming tools
22 Description: Various R programming tools
3 Depends: R
4 Version: 2.3.1
3 Version: 2.4.0
54 Author: Gregory R. Warnes. Includes R source code and/or documentation
65 contributed by Ben Bolker and Thomas Lumley
76 Maintainer: Gregory R. Warnes <warnes@bst.rochester.edu>
87 License: LGPL 2.1
9 Packaged: Sat Apr 7 09:42:10 2007; warnes
8 Packaged: Wed Aug 8 06:58:05 2007; warnes
+2
-0
NAMESPACE less more
11
22 export(
33 addLast,
4 ask,
45 assert,
6 binsearch,
57 capture,
68 combinations,
79 ddirichlet,
+12
-0
NEWS less more
0 gtools 2.4.0
1 ------------
2
3 - Add binsearch() function, previously in the genetics() package.
4
5
6 gtoosl 2.3.1
7 ------------
8
9 - Add ask() function to prompt the user and collect a single response.
10
11
012 gtools 2.3.0
113 ------------
214
+5
-0
R/ask.R less more
0 ask <- function(msg="Press <RETURN> to continue: ")
1 {
2 cat(msg);
3 readLines(con=stdin(),n=1)
4 }
+134
-0
R/binsearch.R less more
0 # $Id: binsearch.R 1295 2007-08-08 13:38:18Z warnes $
1
2 binsearch <- function(fun, range, ..., target=0,
3 lower=ceiling(min(range)),upper=floor(max(range)),
4 maxiter=100, showiter=FALSE)
5 {
6
7 # initialize
8 lo <- lower
9 hi <- upper
10 counter <- 0
11 val.lo <- fun(lo,...)
12 val.hi <- fun(hi,...)
13
14 # check whether function is increasing or decreasing, & set sign
15 # appropriately.
16 if( val.lo > val.hi )
17 sign <- -1
18 else
19 sign <- 1
20
21 # check if value is outside specified range
22 if(target * sign < val.lo * sign)
23 outside.range <- TRUE
24 else if(target * sign > val.hi * sign)
25 outside.range <- TRUE
26 else
27 outside.range <- FALSE
28
29 # iteratively move lo & high closer together until we run out of
30 # iterations, or they are adjacent, or they are identical
31 while(counter < maxiter && !outside.range )
32 {
33
34 counter <- counter+1
35
36 if(hi-lo<=1 || lo<lower || hi>upper) break;
37
38 center <- round((hi - lo)/2 + lo ,0 )
39 val <- fun(center, ...)
40
41 if(showiter)
42 {
43 cat("--------------\n")
44 cat("Iteration #", counter, "\n")
45 cat("lo=",lo,"\n")
46 cat("hi=",hi,"\n")
47 cat("center=",center,"\n")
48 cat("fun(lo)=",val.lo,"\n")
49 cat("fun(hi)=",val.hi,"\n")
50 cat("fun(center)=",val,"\n")
51 }
52
53
54 if( val==target )
55 {
56 val.lo <- val.hi <- val
57 lo <- hi <- center
58 break;
59 }
60 else if( sign*val < sign*target )
61 {
62 lo <- center
63 val.lo <- val
64 }
65 else #( val > target )
66 {
67 hi <- center
68 val.hi <- val
69 }
70
71 if(showiter)
72 {
73 cat("new lo=",lo,"\n")
74 cat("new hi=",hi,"\n")
75 cat("--------------\n")
76 }
77
78 }
79
80 # Create return value
81 retval <- list()
82 retval$call <- match.call()
83 retval$numiter <- counter
84
85 if( outside.range )
86 {
87 if(target * sign < val.lo * sign)
88 {
89 warning("Reached lower boundary")
90 retval$flag="Lower Boundary"
91 retval$where=lo
92 retval$value=val.lo
93 }
94 else #(target * sign > val.hi * sign)
95 {
96 warning("Reached upper boundary")
97 retval$flag="Upper Boundary"
98 retval$where=hi
99 retval$value=val.hi
100 }
101 }
102 else if( counter >= maxiter )
103 {
104 warning("Maximum number of iterations reached")
105 retval$flag="Maximum number of iterations reached"
106 retval$where=c(lo,hi)
107 retval$value=c(val.lo,val.hi)
108 }
109 else if( val.lo==target )
110 {
111 retval$flag="Found"
112 retval$where=lo
113 retval$value=val.lo
114 }
115 else if( val.hi==target )
116 {
117 retval$flag="Found"
118 retval$where=lo
119 retval$value=val.lo
120 }
121 else
122 {
123 retval$flag="Between Elements"
124 retval$where=c(lo, hi)
125 retval$value=c(val.lo, val.hi)
126 }
127
128 return(retval)
129
130 }
131
132
133
+36
-0
man/ask.Rd less more
0 \name{ask}
1 \alias{ask}
2 \title{Display a prompt and collect the user's response}
3 \description{
4 Display a prompt and collect the user's response
5 }
6 \usage{
7 ask(msg = "Press <RETURN> to continue: ")
8 }
9 \arguments{
10 \item{msg}{Character vetor providing the message to be displayed}
11 }
12 \details{
13 The prompt message will be displayed, and then \code{readLines} is
14 used to collect a single input value (possibly empty), which is then
15 returned.
16 }
17 \value{
18 A character scalar containing the input providede by the user.
19 }
20 \author{Gregory R. Warnes \email{greg@random-technologies-llc.com}}
21 \seealso{ \code{\link{readLines}}, \code{\link{scan}} }
22 \examples{
23
24 # use default prompt
25 ask()
26
27 silly <- function()
28 {
29 age <- ask("How old aroe you? ")
30 age <- as.numeric(age)
31 cat("In 10 years you will be", age+10, "years old!\n")
32 }
33
34 }
35 \keyword{IO}
+103
-0
man/binsearch.Rd less more
0 % $Id: binsearch.Rd 1087 2006-11-11 04:09:59Z warnes $
1
2 \name{binsearch}
3 \alias{binsearch}
4 \title{Binary Search}
5 \description{
6 Search within a specified range to locate an integer parameter which
7 results in the the specified monotonic function obtaining a given value.
8 }
9 \usage{
10 binsearch(fun, range, ..., target = 0, lower = ceiling(min(range)),
11 upper = floor(max(range)), maxiter = 100, showiter = FALSE)
12 }
13 \arguments{
14 \item{fun}{Monotonic function over which the search will be performed.}
15 \item{range}{2-element vector giving the range for the search.}
16 \item{\dots}{Additional parameters to the function \code{fun}.}
17 \item{target}{Target value for \code{fun}. Defaults to 0.}
18 \item{lower}{Lower limit of search range. Defaults to \code{min(range)}.}
19 \item{upper}{Upper limit of search range. Defaults to \code{max(range)}.}
20 \item{maxiter}{ Maximum number of search iterations. Defaults to 100.}
21 \item{showiter}{ Boolean flag indicating whether the algorithm state
22 should be printed at each iteration. Defaults to FALSE.}
23 }
24 \details{
25 This function implements an extension to the standard binary search
26 algorithm for searching a sorted list. The algorithm has been
27 extended to cope with cases where an exact match is not possible, to
28 detect whether that the function may be monotonic increasing or
29 decreasing and act appropriately, and to detect when the target value
30 is outside the specified range.
31
32 The algorithm initializes two variable \code{lo} and
33 \code{high} to the extremes values of \code{range}. It then generates
34 a new value \code{center} halfway between \code{lo} and \code{hi}. If
35 the value of \code{fun} at \code{center} exceeds \code{target}, it
36 becomes the new value for \code{lo}, otherwise it becomes the new
37 value for \code{hi}. This process is iterated until \code{lo} and
38 \code{hi} are adjacent. If the function at one or the other equals
39 the target, this value is returned, otherwise \code{lo}, \code{hi},
40 and the function value at both are returned.
41
42 Note that when the specified target value falls between integers, the
43 \em{two} closest values are returned. If the specified target falls
44 outside of the specified \code{range}, the closest endpoint of the
45 range will be returned, and an warning message will be generated. If
46 the maximum number if iterations was reached, the endpoints of the
47 current subset of the range under consideration will be returned.
48 }
49 \value{
50 A list containing:
51 \item{call}{How the function was called.}
52 \item{numiter}{The number of iterations performed}
53 \item{flag }{One of the strings, "Found", "Between Elements",
54 "Maximum number of iterations reached", "Reached lower boundary", or
55 "Reached upper boundary."}
56 \item{where}{One or two values indicating where the search
57 terminated.}
58 \item{value}{Value of the function \code{fun} at the values of
59 \code{where}.}
60 }
61 %\references{ ~put references to the literature/web site here ~ }
62 \author{Gregory R. Warnes \email{warnes@bst.rochester.edu} }
63 \note{This function often returns two values for \code{where} and
64 \code{value}. Be sure to check the \code{flag} parameter to see what
65 these values mean.}
66 \seealso{ \code{\link[base]{optim}}, \code{\link[base]{optimize}},
67 \code{\link[base]{uniroot}} }
68 \examples{
69
70 ### Toy examples
71
72 # search for x=10
73 binsearch( function(x) x-10, range=c(0,20) )
74
75 # search for x=10.1
76 binsearch( function(x) x-10.1, range=c(0,20) )
77
78 ### Classical toy example
79
80 # binary search for the index of 'M' among the sorted letters
81 fun <- function(X) ifelse(LETTERS[X] > 'M', 1,
82 ifelse(LETTERS[X] < 'M', -1, 0 ) )
83
84 binsearch( fun, range=1:26 )
85 # returns $where=13
86 LETTERS[13]
87
88 ### Substantive example, from genetics
89 \dontrun{
90 library(genetics)
91 # Determine the necessary sample size to detect all alleles with
92 # frequency 0.07 or greater with probability 0.95.
93 power.fun <- function(N) 1 - gregorius(N=N, freq=0.07)$missprob
94
95 binsearch( power.fun, range=c(0,100), target=0.95 )
96
97 # equivalent to
98 gregorius( freq=0.07, missprob=0.05)
99 }
100 }
101 \keyword{optimize}
102 \keyword{programming}
+2
-2
man/combinations.Rd less more
0 % $Id: combinations.Rd 1012 2006-11-14 22:25:06Z ggorjan $
0 % $Id: combinations.Rd 1100 2007-07-18 11:48:20Z ggorjan $
11 %
22 \name{combinations}
33 \alias{combinations}
2020 \item{set}{ Logical flag indicating whether duplicates should be
2121 removed from the source vector \code{v}. Defaults to \code{TRUE}.}
2222 \item{repeats.allowed}{ Logical flag indicating whether the
23 constructed vectors nay include duplicated values. Defaults to
23 constructed vectors may include duplicated values. Defaults to
2424 \code{FALSE}. }
2525 }
2626 \details{