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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
#############################################################
# #
# as.circular function #
# Author: Claudio Agostinelli #
# Email: claudio@unive.it #
# Date: May, 31, 2006 #
# Copyright (C) 2006 Claudio Agostinelli #
# #
# Version 0.2-1 #
#############################################################
as.circular <- function (x, control.circular=list(), ...) {
if (is.circular(x))
return(x)
else if (!is.null(xcircularp <- circularp(x)))
circular(x, type=xcircularp$type, units=xcircularp$units, template=xcircularp$template, modulo=xcircularp$modulo, zero=xcircularp$zero, rotation=xcircularp$rotation)
else {
warntype <- warnunits <- warntemplate <- warnrotation <- warnmodulo <- warnzero <- ""
printwarn <- FALSE
dotc <- list(..., expand=TRUE)
dc <- control.circular
if (is.null(dc$type)) {
if (!is.null(dotc$type))
dc$type <- dotc$type
else {
dc$type <- "angles"
warntype <- " type: 'angles'\n"
printwarn <- TRUE
}
}
if (is.null(dc$units)) {
if (!is.null(dotc$units))
dc$units <- dotc$units
else {
dc$units <- "radians"
warnunits <- " units: 'radians'\n"
printwarn <- TRUE
}
}
if (is.null(dc$template)) {
if (!is.null(dotc$template))
dc$template <- dotc$template
else {
dc$template <- "none"
warntemplate <- " template: 'none'\n"
printwarn <- TRUE
}
}
if (is.null(dc$modulo)) {
if (!is.null(dotc$modulo))
dc$modulo <- dotc$modulo
else {
dc$modulo <- "asis"
warnmodulo <- " modulo: 'asis'\n"
printwarn <- TRUE
}
}
if (is.null(dc$zero)) {
if (!is.null(dotc$zero))
dc$zero <- dotc$zero
else {
dc$zero <- 0
warnzero <- " zero: 0\n"
printwarn <- TRUE
}
}
if (is.null(dc$rotation)) {
if (!is.null(dotc$rotation))
dc$rotation <- dotc$rotation
else {
dc$rotation <- "counter"
warnrotation <- " rotation: 'counter'\n"
printwarn <- TRUE
}
}
if (printwarn) {
warn <- paste("an object is coerced to the class 'circular' using default value for the following components:\n", warntype, warnunits, warntemplate, warnmodulo, warnzero, warnrotation, sep="")
warning(warn, sys.call(-1))
}
circular(x, type=dc$type, units=dc$units, template=dc$template, modulo=dc$modulo, zero=dc$zero, rotation=dc$rotation)
}
}
|
