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
|
#############################################################
# #
# Original Splus: Ulric Lund #
# E-mail: ulund@calpoly.edu #
# #
#############################################################
#############################################################
# #
# mean.circular function #
# Author: Claudio Agostinelli #
# E-mail: claudio@unive.it #
# Date: May, 12, 2015 #
# Version: 0.5-1 #
# #
# Copyright (C) 2015 Claudio Agostinelli #
# #
#############################################################
mean.circular <- function(x, na.rm=FALSE, control.circular=list(), ...) {
if (na.rm)
x <- x[!is.na(x)]
if (length(x)==0) {
warning("No observations (at least after removing missing values)")
return(circular(NA))
}
if (is.circular(x)) {
datacircularp <- circularp(x)
} else {
datacircularp <- list(type="angles", units="radians", template="none", modulo="asis", zero=0, rotation="counter")
}
dc <- control.circular
if (is.null(dc$type))
dc$type <- datacircularp$type
if (is.null(dc$units))
dc$units <- datacircularp$units
if (is.null(dc$template))
dc$template <- datacircularp$template
if (is.null(dc$modulo))
dc$modulo <- datacircularp$modulo
if (is.null(dc$zero))
dc$zero <- datacircularp$zero
if (is.null(dc$rotation))
dc$rotation <- datacircularp$rotation
x <- conversion.circular(x, units="radians")
attr(x, "class") <- attr(x, "circularp") <- NULL
circmean <- MeanCircularRad(x)
circmean <- conversion.circular(circular(circmean, template=datacircularp$template, zero=datacircularp$zero, rotation=datacircularp$rotation), dc$units, dc$type, dc$template, dc$modulo, dc$zero, dc$rotation)
return(circmean)
}
MeanCircularRad <- function(x)
{
if (any(is.na(x))) {
circmean <- NA
} else {
circmean <- .C("MeanCircularRad",x=as.double(x),n=as.integer(length(x)),result=as.double(0),PACKAGE="circular")$result
}
return(circmean)
}
|
