R Under development (unstable) (2025-11-06 r88990 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2025 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> 
>  myfun <- function(x, alternative = c("two.sided", "less", "greater")) {
+      alternative <- match.arg(alternative)
+      absx <- abs(x)
+      ntiezero <- sum(absx == 0)
+      foo <- split(x, absx)
+      foo <- foo[names(foo) != "0"]
+      foop <- sapply(foo, function(bar) sum(bar > 0))
+      foon <- sapply(foo, function(bar) sum(bar < 0))
+      mtie <- as.numeric(foon[foop > 0 & foon > 0])
+      ntie <- as.numeric(foop[foop > 0 & foon > 0])
+      plist <- list()
+      if (ntiezero > 0) {
+         i <- seq(0, ntiezero * (ntiezero + 1) / 2)
+         plist[[length(plist) + 1]] <- dsignrank(i, ntiezero)
+      }
+      for (j in 1:length(mtie)) {
+         i <- seq(0, mtie[j] * ntie[j])
+         plist[[length(plist) + 1]] <- dwilcox(i, mtie[j], ntie[j])
+      }
+      ptie <- 1
+      for (j in 1:length(plist))
+         ptie <- convolve(plist[[j]], rev(ptie), type = "o")
+      w <- outer(x, x, "+")
+      w <- w[lower.tri(w, diag = TRUE)]
+      ll <- sum(w < 0)
+      tt <- sum(w == 0)
+      uu <- sum(w > 0)
+      if (tt != sum(sapply(plist, length) - 1))
+          stop("OOPS!")
+      if (alternative == "greater") {
+          return(list(knots = psignrank(seq(ll - 1, ll + tt), length(x)),
+              values = cumsum(c(0, ptie))))
+      }
+      if (alternative == "less") {
+          return(list(knots = psignrank(seq(uu - 1, uu + tt), length(x)),
+              values = cumsum(c(0, ptie))))
+      }
+      if (alternative == "two.sided") {
+          wmin <- min(ll, uu)
+          wmax <- wmin + tt
+          w <- seq(wmin, wmax)
+          pknot <- dsignrank(w, length(x))
+          N <- length(x) * (length(x) + 1) / 2
+          w <- pmin(w, N - w)
+          foo <- split(ptie, w)
+          foo <- sapply(foo, sum)
+          foo <- cumsum(c(0, foo))
+          bar <- pmin(1, 2 * psignrank(seq(min(w) - 1, max(w)), length(x)))
+          return(list(knots = as.numeric(bar), values = as.numeric(foo)))
+      }
+  }
> 
>  library(fuzzyRankTests)
> 
>  options(digits=5) # avoid rounding differences
> 
>  x <- as.double(c(-3, -2, -2, 0, 0, 0, 0, 1, 2, 3, 4, 4, 4, 5, 6, 7))
>  mu <- as.double(0)
>  tol <- sqrt(.Machine$double.eps)
> 
>  out <- .Call(fuzzyRankTests:::C_fpvsignrank, x, mu, "less", tol)
>  print(out)
$knots
 [1] 0.95328 0.95837 0.96304 0.96730 0.97116 0.97467 0.97784 0.98068 0.98323
[10] 0.98550 0.98752 0.98930 0.99088 0.99225 0.99345

$values
 [1] 0.000000 0.010417 0.041667 0.093750 0.166667 0.260417 0.375000 0.500000
 [9] 0.625000 0.739583 0.833333 0.906250 0.958333 0.989583 1.000000

>  all.equal(out, myfun(x, "less"))
[1] TRUE
> 
>  x2 <- as.double(c(-4, -4, x))
> 
>  out <- .Call(fuzzyRankTests:::C_fpvsignrank, x2, mu, "less", tol)
>  print(out)
$knots
 [1] 0.81539 0.82673 0.83764 0.84810 0.85814 0.86774 0.87690 0.88562 0.89393
[10] 0.90181 0.90927 0.91632 0.92298 0.92924 0.93513 0.94065 0.94581 0.95063
[19] 0.95512 0.95929 0.96316

$values
 [1] 0.0000000 0.0010417 0.0052083 0.0156250 0.0364583 0.0718750 0.1250000
 [8] 0.1968750 0.2864583 0.3895833 0.5000000 0.6104167 0.7135417 0.8031250
[15] 0.8750000 0.9281250 0.9635417 0.9843750 0.9947917 0.9989583 1.0000000

>  all.equal(out, myfun(x2, "less"))
[1] TRUE
> 
>  mutoo <- as.double(2)
> 
>  out <- .Call(fuzzyRankTests:::C_fpvsignrank, x, mutoo, "greater", tol)
>  print(out)
$knots
 [1] 0.41045 0.43013 0.44997 0.46994 0.48997 0.51003 0.53006 0.55003 0.56987
[10] 0.58955 0.60902 0.62822 0.64714 0.66573 0.68391 0.70171 0.71906 0.73592
[19] 0.75229

$values
 [1] 0.0000000 0.0011905 0.0071429 0.0226190 0.0523810 0.1011905 0.1726190
 [8] 0.2666667 0.3785714 0.5000000 0.6214286 0.7333333 0.8273810 0.8988095
[15] 0.9476190 0.9773810 0.9928571 0.9988095 1.0000000

>  all.equal(out, myfun(x - mutoo, "great"))
[1] TRUE
> 
>  ##### check for error found in devel ####
>  try(.Call(fuzzyRankTests:::C_fpvsignrank, x, mutoo, "two", tol))
Error in try(.Call(fuzzyRankTests:::C_fpvsignrank, x, mutoo, "two", tol)) : 
  'alternative' not recognized
> 
>  out <- .Call(fuzzyRankTests:::C_fpvsignrank, x, mutoo, "two.sided", tol)
>  print(out)
$knots
 [1] 0.49542 0.52817 0.56189 0.59659 0.63217 0.66855 0.70572 0.74356 0.78195
[10] 0.82089 0.86026 0.89993 0.93988 0.97995 1.00000

$values
 [1] 0.0000000 0.0011905 0.0071429 0.0226190 0.0523810 0.1011905 0.1726190
 [8] 0.2666667 0.3785714 0.5000000 0.6226190 0.7404762 0.8500000 0.9511905
[15] 1.0000000

>  all.equal(out, myfun(x - mutoo, "two"))
[1] TRUE
> 
> 
> proc.time()
   user  system elapsed 
   0.20    0.06    0.21