The R Project SVN R

Rev

Rev 88896 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 88896 Rev 89238
Line 1... Line 1...
1 
% File src/library/stats/man/approxfun.Rd
 1 
% File src/library/stats/man/approxfun.Rd
2 
% Part of the R package, https://www.R-project.org
 2 
% Part of the R package, https://www.R-project.org
3 
% Copyright 1995-2022 R Core Team
 3 
% Copyright 1995-2025 R Core Team
4 
% Distributed under GPL 2 or later
 4 
% Distributed under GPL 2 or later
5 
 
 5 
 
6 
\name{approxfun}
 6 
\name{approxfun}
7 
\alias{approx}
 7 
\alias{approx}
8 
\alias{approxfun}
 8 
\alias{approxfun}
Line 142... Line 142...
142 
## NAs in x[] are not allowed:
 142 
## NAs in x[] are not allowed:
143 
stopifnot(inherits( try( approx(yn,yn, na.rm=FALSE) ), "try-error"))
 143 
stopifnot(inherits( try( approx(yn,yn, na.rm=FALSE) ), "try-error"))
144 
 
 144 
 
145 
## Give a nice overview of all possibilities  rule * method * na.rm :
 145 
## Give a nice overview of all possibilities  rule * method * na.rm :
146 
##             -----------------------------  ====   ======   =====
 146 
##             -----------------------------  ====   ======   =====
147 
## extrapolations "N":= NA;   "C":= Constant :
 147 
## extrapolation 'rule's "N":= NA;   "C":= Constant :
- 
 
 148 
allapprox <- function(x, y, xout = NULL, ...) {
- 
 
 149 
  if(is.null(xout)) { rx <- range(x, na.rm=TRUE); xout <- seq(rx[1], rx[2], length.out = 25) }
148 
rules <- list(N=1, C=2, NC=1:2, CN=2:1)
 150 
  rules <- list(N=1, C=2, NC=1:2, CN=2:1)
149 
methods <- c("constant","linear")
 151 
  methods <- c("constant", "linear")
150 
ry <- sapply(rules, function(R) {
 152 
  ry <- sapply(rules, function(R) {
151 
       sapply(methods, function(M)
 153 
         sapply(methods, function(M)
152 
        sapply(setNames(,c(TRUE,FALSE)), function(na.)
 154 
          sapply(setNames(, c(TRUE,FALSE)), function(na.)
153 
                 approx(xn, yn, xout=xout, method=M, rule=R, na.rm=na.)$y),
 155 
                 approx(x, y, xout=xout, method=M, rule=R, na.rm=na., ...)$y),
154 
        simplify="array")
 156 
                simplify="array")
155 
   }, simplify="array")
 157 
   }, simplify="array")
156 
names(dimnames(ry)) <- c("x = ", "na.rm", "method", "rule")
 158 
  names(dimnames(ry)) <- c("x = ", "na.rm", "method", "rule")
157 
dimnames(ry)[[1]] <- format(xout)
 159 
  dimnames(ry)[[1]] <- format(xout)
158 
ftable(aperm(ry, 4:1)) # --> (4 * 2 * 2) x length(xout)  =  16 x 9 matrix
 160 
  ftable(aperm(ry, 4:1)) # --> (4 * 2 * 2) x length(xout)  =  16 x 9 matrix
- 
 
 161 
}
- 
 
 162 
 
- 
 
 163 
(ry <- allapprox(xn, yn, xout)) # nice ftable
159 
\dontshow{% functionality and consistency tests:
 164 
\dontshow{% functionality and consistency tests:%
160 
ryna <- ry
 165 
ryna <- ry
161 
ryna[is.na(ryna)] <- NA ## approx may turn NAs into NaNs
 166 
ryna[is.na(ryna)] <- NA ## approx may turn NAs into NaNs
162 
stopifnot(exprs = {
 167 
stopifnot(exprs = {
163 
 identical(unname(ryna),
 168 
 identical(unname(unclass(aperm(as.table(ryna), 4:1))),
164 
   array(c(NA, 1, 1,   1, 1, 3, 3, 4, NA,      NA, 1,  1, NA, NA, 3, 3, 4, NA,
 169 
   array(c(NA, 1, 1,   1, 1, 3, 3, 4, NA,      NA, 1,  1, NA, NA, 3, 3, 4, NA,
165 
           NA, 1, 1.5, 2, 2.5, 3, 3.5, 4, NA,  NA, 1, NA, NA, NA, 3, 3.5, 4, NA,
 170 
           NA, 1, 1.5, 2, 2.5, 3, 3.5, 4, NA,  NA, 1, NA, NA, NA, 3, 3.5, 4, NA,
166 
            1, 1, 1,   1, 1, 3, 3, 4, 4,        1, 1,  1, NA, NA, 3, 3, 4, 4,
 171 
            1, 1, 1,   1, 1, 3, 3, 4, 4,        1, 1,  1, NA, NA, 3, 3, 4, 4,
167 
            1, 1, 1.5, 2, 2.5, 3, 3.5, 4, 4,    1, 1, NA, NA, NA, 3, 3.5, 4, 4,
 172 
            1, 1, 1.5, 2, 2.5, 3, 3.5, 4, 4,    1, 1, NA, NA, NA, 3, 3.5, 4, 4,
168 
           NA, 1, 1,   1, 1, 3, 3, 4, 4,       NA, 1,  1, NA, NA, 3, 3, 4, 4,
 173 
           NA, 1, 1,   1, 1, 3, 3, 4, 4,       NA, 1,  1, NA, NA, 3, 3, 4, 4,
169 
           NA, 1, 1.5, 2, 2.5, 3, 3.5, 4, 4,   NA, 1, NA, NA, NA, 3, 3.5, 4, 4,
 174 
           NA, 1, 1.5, 2, 2.5, 3, 3.5, 4, 4,   NA, 1, NA, NA, NA, 3, 3.5, 4, 4,
170 
            1, 1, 1,   1, 1, 3, 3, 4, NA,       1, 1,  1, NA, NA, 3, 3, 4, NA,
 175 
            1, 1, 1,   1, 1, 3, 3, 4, NA,       1, 1,  1, NA, NA, 3, 3, 4, NA,
171 
            1, 1, 1.5, 2, 2.5, 3, 3.5, 4, NA,   1, 1, NA, NA, NA, 3, 3.5, 4, NA),
 176 
            1, 1, 1.5, 2, 2.5, 3, 3.5, 4, NA,   1, 1, NA, NA, NA, 3, 3.5, 4, NA),
172 
         dim = c(9L, 2L, 2L, 4L)))
 177 
         dim = c(9L, 2L, 2L, 4L)))
173 
 identical(approxfun(xn,yn, method="constant", rule=2, na.rm=FALSE)(xout),
 178 
 identical(approxfun(xn,yn, method="constant", rule=2, na.rm=FALSE)(xout),
174 
            as.vector(ry[,"FALSE", "constant","C"]))
 179 
           unname(as.matrix(ry)["C_constant_FALSE", ]))
175 
 identical(approxfun(xn,yn, method="linear", rule=2:1, na.rm=FALSE)(xout),
 180 
 identical(approxfun(xn,yn, method="linear", rule=2:1, na.rm=FALSE)(xout),
176 
            as.vector(ry[,"FALSE", "linear", "CN"]))
 181 
           unname(as.matrix(ry)["CN_linear_FALSE", ]))
177 
})
 182 
})
178 
}
 183 
}%% not showing check
179 
 
 184 
 
180 
## Show treatment of 'ties' :
 185 
## Show treatment of 'ties' :
181 
 
 186 
 
182 
x <- c(2,2:4,4,4,5,5,7,7,7)
 187 
x <- c(2,2:4,4,4,5,5,7,7,7)
183 
y <- c(1:6, 5:4, 3:1)
 188 
y <- c(   1:6,   5:4, 3:1)
184 
(amy <- approx(x, y, xout = x)$y) # warning, can be avoided by specifying 'ties=':
 189 
(amy <- approx(x, y, xout = x)$y) # warning, can be avoided by specifying 'ties=':
185 
op <- options(warn=2) # warnings would be error
 190 
op <- options(warn=2) # warnings would be error
186 
stopifnot(identical(amy, approx(x, y, xout = x, ties=mean)$y))
 191 
stopifnot(identical(amy, approx(x, y, xout = x, ties=mean)$y))
187 
(ay <- approx(x, y, xout = x, ties = "ordered")$y)
 192 
(ay <- approx(x, y, xout = x, ties = "ordered")$y)
188 
stopifnot(amy == c(1.5,1.5, 3, 5,5,5, 4.5,4.5, 2,2,2),
 193 
stopifnot(amy == c(1.5,1.5, 3, 5,5,5, 4.5,4.5, 2,2,2),
189 
          ay  == c(2, 2,    3, 6,6,6, 4, 4,    1,1,1))
 194 
          ay  == c(2, 2,    3, 6,6,6, 4, 4,    1,1,1))
190 
approx(x, y, xout = x, ties = min)$y
 195 
approx(x, y, xout = x, ties = min)$y
191 
approx(x, y, xout = x, ties = max)$y
 196 
approx(x, y, xout = x, ties = max)$y
- 
 
 197 
 
- 
 
 198 
## 'ties' + NAs -- notably NAs for tied x[], situation as PR#17604
- 
 
 199 
 
- 
 
 200 
x <- c(2:3, 3:5, 5:7)
- 
 
 201 
y <- c(1,NA,2:4,NA,1,0)
- 
 
 202 
## allapprox() [defined above] for all variants :
- 
 
 203 
(ryN <- allapprox(x, y, xout = seq(2, 7.5, by = 1/2), ties = mean))
- 
 
 204 
str(tbN <- as.table(ryN)) # 4 x 2 x 2 x 12 array
- 
 
 205 
stopifnot(is.na( tbN[,, na.rm="FALSE", format(c(3, 3.5, 5, 5.5))] ))
- 
 
 206 
## 3 and 3.5 gave values in {2, 2.5} instead of NA, in R <= 4.5.2
- 
 
 207 
\dontshow{
- 
 
 208 
maN <- as.matrix(ryN); maN[is.na(maN)] <- NA # replace possible `NaN`s
- 
 
 209 
stopifnot(exprs = {
- 
 
 210 
    is.function(x16 <- function(...) rep_len(c(...), 16L))
- 
 
 211 
    identical(unname(maN),
- 
 
 212 
      cbind(deparse.level=0,
- 
 
 213 
            x16(1),     x16(1, 1,  1.5, NA),
- 
 
 214 
            x16(2, NA), x16(2, NA, 2.5, NA),
- 
 
 215 
            x16(3),     x16(3, 3,  3.5, NA),
- 
 
 216 
            x16(4, NA), x16(4, NA, 2.5, NA),
- 
 
 217 
            x16(1),     x16(1, 1,  0.5, 0.5),
- 
 
 218 
            x16(0),     rep(c(NA, 0, 0, NA), each = 4)))
- 
 
 219 
})
192 
options(op) # revert 'warn'ing level
 220 
options(op) # revert 'warn'ing level
- 
 
 221 
}
193 
}%% MM has nice utility plotting in MISC/approx-ex.R -- do in demo ?
 222 
}%% MM has nice utility plotting in MISC/approx-ex.R -- do in demo ?
194 
\keyword{arith}
 223 
\keyword{arith}
195 
\keyword{dplot}
 224 
\keyword{dplot}