1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
#############################################################
# #
# subset.circular function #
# Author: Claudio Agostinelli #
# E-mail: claudio@unive.it #
# Date: March, 7, 2003 #
# Version: 0.1 #
# #
# Copyright (C) 2003 Claudio Agostinelli #
# #
#############################################################
### do not work fine yet
subset.circular <- function(x, subset, select, ...) {
xcircularp <- attr(x, "circularp")
x <- unclass(x)
ismatrix <- is.matrix(x)
x <- as.data.frame(x)
if(missing(subset))
r <- TRUE
else {
e <- substitute(subset)
r <- eval(e, x, parent.frame())
r <- r & !is.na(r)
}
if(missing(select))
vars <- TRUE
else {
nl <- as.list(1:ncol(x))
names(nl) <- names(x)
vars <- eval(substitute(select),nl, parent.frame())
}
x <- x[r,vars,drop=FALSE]
if (ismatrix) x <- as.matrix(x)
attr(x, "circularp") <- xcircularp
attr(x, "class") <- "circular"
return(x)
}
|
