1+ # ' Class permtest
2+ # '
3+ # ' This class represents the permutation test outcomes. See also
4+ # ' the function \code{\link{permtest}}.
5+ # '
6+ # ' @slot orig_loss a numeric value with the original loss of
7+ # ' the model.
8+ # ' @slot perm_losses a numeric vector with the losses of the
9+ # ' different permutations.
10+ # ' @slot n the number of permutations
11+ # ' @slot loss_function the function used to calculate the losses.
12+ # ' @slot exclusion a character value indicating the exclusion
13+ # ' setting used for the test
14+ # ' @slot replaceby0 a locigal value that indicates whether the
15+ # ' exclusion was done by replacing with zero. See also
16+ # ' \code{\link{loo}}.
17+ # ' @slot permutation a character value that indicats in which
18+ # ' kernel matrices were permuted.
19+ # ' @slot pval a p value indicating how likely it is to find a
20+ # ' smaller loss than the one of the model based on a normal
21+ # ' approximation.
22+ # '
23+ # ' @seealso
24+ # ' * the function \code{\link{permtest}} for the actual test.
25+ # ' * the function \code{\link{loo}} for the leave one out
26+ # ' procedures
27+ # ' * the function \code{\link{t.test}} for the actual test
28+ # ' @md
29+ # '
30+ # ' @include all_generics.R
31+ # '
32+ # ' @rdname permtest-class
33+ # ' @name permtest-class
34+ # ' @exportClass permtest
35+ setClass ("permtest ",
36+ slots = c(orig_loss = " numeric"
37+ perm_losses = " numeric"
38+ n = " numeric"
39+ loss_function = " function"
40+ exclusion = " character"
41+ replaceby0 = " logical"
42+ permutation = " character"
43+ pval = " numeric"
44+
45+ # Validity testing
46+ validPermtest <- function (object ){
47+ if (length(object @ orig_loss )!= 1 )
48+ return (" orig_loss should be a single value."
49+ if (length(object @ pval )!= 1 )
50+ return (" pval should be a single value."
51+ if (length(object @ perm_losses )!= object @ n )
52+ return (" perm_losses doesn't have a length of n."
53+
54+ }
55+
56+ setValidity(" permtest" validPermtest )
57+
58+ # Show method
59+ print.permtest <- function (x ,digits = max(3L , getOption(" digits" - 3 )){
60+
61+ if (identical(x @ loss_function ,loss_mse ))
62+ loss_name <- " Mean Squared Error (loss_mse)"
63+ else if (identical(x @ loss_function ,loss_auc ))
64+ loss_name <- " Area under curve (loss_auc)"
65+ else
66+ loss_name <- " custom function by user"
67+
68+ excl <- x @ exclusion
69+ if (x @ replaceby0 )excl <- paste(excl ," (values replaced by 0)"
70+
71+ loss_name <- paste(" Loss function:" loss_name ," \n "
72+ excl <- paste(" Exclusion:" excl ," \n "
73+ perm <- paste(" Permutation:" x @ permutation ," \n "
74+
75+ avg <- mean(x @ perm_losses )
76+ sd <- sd(x @ perm_losses )
77+ # results
78+ res <- matrix (
79+ c(x @ orig_loss ,avg ,sd ,x @ pval ),
80+ nrow = 1 ,
81+ dimnames = list (
82+ " "
83+ c(" Loss" " Average loss" " sd" " Pr(X < Loss)"
84+ )
85+ )
86+
87+
88+
89+ cat(" \n "
90+ cat(strwrap(" Permutation test for a tskrr model" prefix = " \t "
91+ cat(" \n "
92+ cat(" Using:\n "
93+ cat(loss_name )
94+ cat(excl )
95+ cat(perm )
96+ cat(" \n "
97+ printCoefmat(res ,digits = digits )
98+ cat(" \n "
99+ cat(" P value is approximated based on a normal distribution.\n "
100+
101+ }
102+
103+ setMethod ("show ",
104+ " permtest"
105+ function (object ){
106+ print.permtest(object )
107+ })