From 0c3015dd74c03744c097bbeb9bb4de68ef90d351 Mon Sep 17 00:00:00 2001 From: Jaroslav Borodavka <df2994@kit.edu> Date: Fri, 12 Apr 2024 14:22:40 +0200 Subject: [PATCH] Translated to German and added a preamble. --- R/Comp_Statistics.R | 37 +++++++++++++++++++++++-------------- 1 file changed, 23 insertions(+), 14 deletions(-) diff --git a/R/Comp_Statistics.R b/R/Comp_Statistics.R index 41bdbee..0f040b2 100644 --- a/R/Comp_Statistics.R +++ b/R/Comp_Statistics.R @@ -1,19 +1,28 @@ +################################################################################################# +################################################################################################# +## This script collects all the competing test statistics that are used in the simulation study, +## cf. section 6 of the main manuscript. It is not specifically loaded in other scripts, but +## might serve useful for some toy example tests. +################################################################################################# +################################################################################################# + +# required packages library(tictoc) library(Directional) library(MASS) library(MonteCarlo) library(data.table) -library(zipfR) # incomplete Beta function +library(zipfR) # contains incomplete Beta function ################################################################################################# -## Konkurrierende Teststatistiken ## +## competing test statistics ## -# Transformation von Einheitsvektoren in zirkuläre Daten via Bogenmaß (nur d = 2), siehe n-sphere auf Wiki +# transformation of unit vectors into circular data via radian (only d = 2) euclidtoangular <- function(unit_data){ return(matrix(data = atan2(unit_data[,2], unit_data[,1]), ncol = 1)) } -# Testentscheid +# test decision Decision <- function(teststatistic_value, critical){ decision <- 0 @@ -26,7 +35,7 @@ Decision <- function(teststatistic_value, critical){ return(decision) } -# Gleichverteilung auf S^(d-1) +# uniformly distributed vectors on S^(d-1) runif_sphere <- function(n, d){ X = mvrnorm(n, rep(0,d), diag(1,d)) if (n == 1){ @@ -43,17 +52,17 @@ runif_sphere <- function(n, d){ return(U) } -# Kuiper-Teststatistik basierend auf Directional-Paket (nur d = 2) +# Kuiper test based on Directional package (only d = 2), data in form of unit vectors Kuiper <- function(data){ return(Directional::kuiper(euclidtoangular(data), rads = TRUE)[1]) } -# Watson-Teststatistik basierend auf Directional-Paket (nur d = 2) +# Watson test based on Directional package (only d = 2), data in form of unit vectors Watson <- function(data){ return(Directional::watson(euclidtoangular(data), rads = TRUE)[1]) } -# Cuesta-Albertos-Teststatistik +# Cuesta-Albertos tests (d=2 and d>2) F_CA <- function(d){ if (d==2){ res <- function(t) 1 - acos(t)/pi @@ -72,7 +81,7 @@ Cuesta_Albertos_unique <- function(data, rdirection){ return(ks.test(projected_data, "cdf")$p.value) } -# 100 gleichverteilte Richtungen fuer die CA-Teststatistik +# 100 uniformly distributed directions rdirections_2 <- runif_sphere(100, 2) rdirections_3 <- runif_sphere(100, 3) rdirections_5 <- runif_sphere(100, 5) @@ -93,12 +102,12 @@ Cuesta_Albertos_multi <- function(data){ return(min(p_values)) } -# Rayleigh-Teststatistik basierend auf Directional-Paket +# Rayleigh test based on Directional package Rayleigh <- function(data){ return(Directional::rayleigh(data, modif = TRUE)[1]) } -# Ajne-Teststatistik +# Ajne test Ajne <- function(data){ n = dim(data)[1] temp = data %*% t(data) @@ -106,7 +115,7 @@ Ajne <- function(data){ return(n/4 - 1/(n*pi)*sum(Psi)) } -# Bingham-Teststatistik +# Bingham test Bingham <- function(data){ n = dim(data)[1] d = dim(data)[2] @@ -118,7 +127,7 @@ Bingham <- function(data){ return(n*d*(d+2)/2*(sum(diag(S %*% S)) - 1/d)) } -# Giné-Teststatistik +# Giné test Gine_G <- function(data){ n = dim(data)[1] d = dim(data)[2] @@ -127,7 +136,7 @@ Gine_G <- function(data){ return(n/2 - (d-1)*gamma((d-1)/2)^2/(2*n*gamma(d/2)^2)*sum(sin(Psi))) } -# Cramér-von Mises-Teststatistik +# Cramér-von Mises test integrand <- function(t, angle, dim){ return(F_CA(dim)(t)*F_CA(dim-1)(t*tan(angle/2)/sqrt(1-t^2))/Cbeta(a = 1/2, b = (dim-1)/2)*(1-t^2)^((dim-3)/2)) } -- GitLab