1. celda
  2. R
  3. elbow.R
Browse code

Ran styler and fixed lints

Joshua D. Campbell authored on 06/04/2020 23:58:56
Showing 1 changed files
R/elbow.R
History View file @ f2a1c1ba
... ... 
@@ -4,42 +4,43 @@
4 4 
 # Kimberling, C. "Triangle Centers and Central Triangles." Congr.
5 5 
 # Numer. 129, 1-295, 1998.
6 6 
 .dist2d <- function(a, b, c) {
7 
-    v1 <- b - c
8 
-    v2 <- a - b
9 
-    m <- cbind(v1, v2)
10 
-    d <- abs(det(m)) / sqrt(sum(v1 * v1))
11 
-    return(d)
7 
+  v1 <- b - c
8 
+  v2 <- a - b
9 
+  m <- cbind(v1, v2)
10 
+  d <- abs(det(m)) / sqrt(sum(v1 * v1))
11 
+  return(d)
12 12 
 }
13 13
14 14
15 15 
 .secondDerivativeEstimate <- function(v) {
16 
-    nv <- length(v)
17 
-    res <- rep(NA, nv)
18 
-    for (i in seq(2, nv - 1)) {
19 
-        res[i] <- v[i + 1] + v[i - 1] - (2 * v[i])
20 
-    }
21 
-    return(res)
16 
+  nv <- length(v)
17 
+  res <- rep(NA, nv)
18 
+  for (i in seq(2, nv - 1)) {
19 
+    res[i] <- v[i + 1] + v[i - 1] - (2 * v[i])
20 
+  }
21 
+  return(res)
22 22 
 }
23 23
24 24
25 25 
 .curveElbow <- function(var, perplexity, pvalCutoff = 0.05) {
26 
-    len <- length(perplexity)
27 
-    a <- c(var[1], perplexity[1])
28 
-    b <- c(var[len], perplexity[len])
29 
-    res <- rep(NA, len)
30 
-    for (i in seq_along(var)) {
31 
-        res[i] <- .dist2d(c(var[i], perplexity[i]), a, b)
32 
-    }
33 
-    elbow <- which.max(res)
34 
-    ix <- var > var[elbow]
35 
-    perplexitySde <- .secondDerivativeEstimate(perplexity)
36 
-    perplexitySdeSd <- stats::sd(perplexitySde[ix], na.rm = TRUE)
37 
-    perplexitySdeMean <- mean(perplexitySde[ix], na.rm = TRUE)
38 
-    perplexitySdePval <-
39 
-        stats::pnorm(perplexitySde,
40 
-            mean = perplexitySdeMean,
41 
-            sd = perplexitySdeSd,
42 
-            lower.tail = FALSE)
43 
-    # other <- which(ix & perplexitySdePval < pvalCutoff)
44 
-    return(list(elbow = var[elbow]))
26 
+  len <- length(perplexity)
27 
+  a <- c(var[1], perplexity[1])
28 
+  b <- c(var[len], perplexity[len])
29 
+  res <- rep(NA, len)
30 
+  for (i in seq_along(var)) {
31 
+    res[i] <- .dist2d(c(var[i], perplexity[i]), a, b)
32 
+  }
33 
+  elbow <- which.max(res)
34 
+  ix <- var > var[elbow]
35 
+  perplexitySde <- .secondDerivativeEstimate(perplexity)
36 
+  perplexitySdeSd <- stats::sd(perplexitySde[ix], na.rm = TRUE)
37 
+  perplexitySdeMean <- mean(perplexitySde[ix], na.rm = TRUE)
38 
+  perplexitySdePval <-
39 
+    stats::pnorm(perplexitySde,
40 
+      mean = perplexitySdeMean,
41 
+      sd = perplexitySdeSd,
42 
+      lower.tail = FALSE
43 
+    )
44 
+  # other <- which(ix & perplexitySdePval < pvalCutoff)
45 
+  return(list(elbow = var[elbow]))
45 46 
 }
Browse code

fix 'stats::mean' NOTE

zhewa authored on 23/04/2019 20:13:42
Showing 1 changed files
R/elbow.R
History View file @ 41ce752b
... ... 
@@ -34,8 +34,7 @@
34 34 
     ix <- var > var[elbow]
35 35 
     perplexitySde <- .secondDerivativeEstimate(perplexity)
36 36 
     perplexitySdeSd <- stats::sd(perplexitySde[ix], na.rm = TRUE)
37 
-    perplexitySdeMean <-
38 
-        stats::mean(perplexitySde[ix], na.rm = TRUE)
37 
+    perplexitySdeMean <- mean(perplexitySde[ix], na.rm = TRUE)
39 38 
     perplexitySdePval <-
40 39 
         stats::pnorm(perplexitySde,
41 40 
             mean = perplexitySdeMean,
Browse code

comment out unused codes

zhewa authored on 20/04/2019 16:07:42
Showing 1 changed files
R/elbow.R
History View file @ 501d7a5b
... ... 
@@ -8,6 +8,7 @@
8 8 
     v2 <- a - b
9 9 
     m <- cbind(v1, v2)
10 10 
     d <- abs(det(m)) / sqrt(sum(v1 * v1))
11 
+    return(d)
11 12 
 }
12 13
13 14
... ... 
@@ -40,6 +41,6 @@
40 41 
             mean = perplexitySdeMean,
41 42 
             sd = perplexitySdeSd,
42 43 
             lower.tail = FALSE)
43 
-    other <- which(ix & perplexitySdePval < pvalCutoff)
44 
+    # other <- which(ix & perplexitySdePval < pvalCutoff)
44 45 
     return(list(elbow = var[elbow]))
45 46 
 }
Browse code

review of reformatted files

zhewa authored on 08/04/2019 17:01:29
Showing 1 changed files
R/elbow.R
History View file @ ca5fb59d
... ... 
@@ -1,4 +1,5 @@
1 
-# https://stackoverflow.com/questions/35194048/using-r-how-to-calculate-the-distance-from-one-point-to-a-line
1 
+# https://stackoverflow.com/questions/35194048/using-r-how-to-calculate
2 
+#-the-distance-from-one-point-to-a-line
2 3 
 # http://mathworld.wolfram.com/Point-LineDistance2-Dimensional.html
3 4 
 # Kimberling, C. "Triangle Centers and Central Triangles." Congr.
4 5 
 # Numer. 129, 1-295, 1998.
... ... 
@@ -9,15 +10,17 @@
9 10 
     d <- abs(det(m)) / sqrt(sum(v1 * v1))
10 11 
 }
11 12
13 
+
12 14 
 .secondDerivativeEstimate <- function(v) {
13 15 
     nv <- length(v)
14 16 
     res <- rep(NA, nv)
15 
-    for (i in 2:(nv - 1)) {
17 
+    for (i in seq(2, nv - 1)) {
16 18 
         res[i] <- v[i + 1] + v[i - 1] - (2 * v[i])
17 19 
     }
18 20 
     return(res)
19 21 
 }
20 22
23 
+
21 24 
 .curveElbow <- function(var, perplexity, pvalCutoff = 0.05) {
22 25 
     len <- length(perplexity)
23 26 
     a <- c(var[1], perplexity[1])
Browse code

Reformat celda_functions.R, celda_heatmap.R

ykoga07 authored on 03/04/2019 15:22:16
Showing 1 changed files
R/elbow.R
History View file @ 0b3c7f9a
... ... 
@@ -18,30 +18,25 @@
18 18 
     return(res)
19 19 
 }
20 20
21 
-.curveElbow <- function(var, perplexity, pval.cutoff = 0.05) {
21 
+.curveElbow <- function(var, perplexity, pvalCutoff = 0.05) {
22 22 
     len <- length(perplexity)
23 
-
24 23 
     a <- c(var[1], perplexity[1])
25 24 
     b <- c(var[len], perplexity[len])
26 25 
     res <- rep(NA, len)
27 26 
     for (i in seq_along(var)) {
28 
-        res[i] <- dist2d(c(var[i], perplexity[i]), a, b)
27 
+        res[i] <- .dist2d(c(var[i], perplexity[i]), a, b)
29 28 
     }
30 
-
31 29 
     elbow <- which.max(res)
32 30 
     ix <- var > var[elbow]
33 
-    perplexity.sde <- secondDerivativeEstimate(perplexity)
34 
-    perplexity.sde.sd <- stats::sd(perplexity.sde[ix], na.rm = TRUE)
35 
-    perplexity.sde.mean <-
36 
-        stats::mean(perplexity.sde[ix], na.rm = TRUE)
37 
-    perplexity.sde.pval <-
38 
-        stats::pnorm(
39 
-            perplexity.sde,
40 
-            mean = perplexity.sde.mean,
41 
-            sd = perplexity.sde.sd,
42 
-            lower.tail = FALSE
43 
-        )
44 
-
45 
-    other <- which(ix & perplexity.sde.pval < pval.cutoff)
46 
-    return(list(elbow = var[elbow])) # , secondary=l[other]))
31 
+    perplexitySde <- .secondDerivativeEstimate(perplexity)
32 
+    perplexitySdeSd <- stats::sd(perplexitySde[ix], na.rm = TRUE)
33 
+    perplexitySdeMean <-
34 
+        stats::mean(perplexitySde[ix], na.rm = TRUE)
35 
+    perplexitySdePval <-
36 
+        stats::pnorm(perplexitySde,
37 
+            mean = perplexitySdeMean,
38 
+            sd = perplexitySdeSd,
39 
+            lower.tail = FALSE)
40 
+    other <- which(ix & perplexitySdePval < pvalCutoff)
41 
+    return(list(elbow = var[elbow]))
47 42 
 }
Browse code

Reformat plot_dr

ykoga07 authored on 02/04/2019 18:53:13
Showing 1 changed files
R/elbow.R
History View file @ 16dba6f7
... ... 
@@ -1,6 +1,7 @@
1 1 
 # https://stackoverflow.com/questions/35194048/using-r-how-to-calculate-the-distance-from-one-point-to-a-line
2 2 
 # http://mathworld.wolfram.com/Point-LineDistance2-Dimensional.html
3 
-# Kimberling, C. "Triangle Centers and Central Triangles." Congr. Numer. 129, 1-295, 1998.
3 
+# Kimberling, C. "Triangle Centers and Central Triangles." Congr.
4 
+# Numer. 129, 1-295, 1998.
4 5 
 .dist2d <- function(a, b, c) {
5 6 
     v1 <- b - c
6 7 
     v2 <- a - b
Browse code

Reformat elbow.R

ykoga07 authored on 02/04/2019 18:23:51
Showing 1 changed files
R/elbow.R
History View file @ 88531e8d
... ... 
@@ -1,40 +1,46 @@
1 1 
 # https://stackoverflow.com/questions/35194048/using-r-how-to-calculate-the-distance-from-one-point-to-a-line
2 2 
 # http://mathworld.wolfram.com/Point-LineDistance2-Dimensional.html
3 3 
 # Kimberling, C. "Triangle Centers and Central Triangles." Congr. Numer. 129, 1-295, 1998.
4 
-dist2d <- function(a,b,c) {
5 
- v1 <- b - c
6 
- v2 <- a - b
7 
- m <- cbind(v1,v2)
8 
- d <- abs(det(m))/sqrt(sum(v1*v1))
9 
-}
4 
+.dist2d <- function(a, b, c) {
5 
+    v1 <- b - c
6 
+    v2 <- a - b
7 
+    m <- cbind(v1, v2)
8 
+    d <- abs(det(m)) / sqrt(sum(v1 * v1))
9 
+}
10 
+
11 
+.secondDerivativeEstimate <- function(v) {
12 
+    nv <- length(v)
13 
+    res <- rep(NA, nv)
14 
+    for (i in 2:(nv - 1)) {
15 
+        res[i] <- v[i + 1] + v[i - 1] - (2 * v[i])
16 
+    }
17 
+    return(res)
18 
+}
19 
+
20 
+.curveElbow <- function(var, perplexity, pval.cutoff = 0.05) {
21 
+    len <- length(perplexity)
10 22
11 
-secondDerivativeEstimate = function(v) {
12 
-  nv = length(v)
13 
-  res = rep(NA, nv)
14 
-  for(i in 2:(nv-1)) {
15 
-    res[i] = v[i+1] + v[i-1] - (2 * v[i])
16 
-  }
17 
-  return(res)
18 
-}
23 
+    a <- c(var[1], perplexity[1])
24 
+    b <- c(var[len], perplexity[len])
25 
+    res <- rep(NA, len)
26 
+    for (i in seq_along(var)) {
27 
+        res[i] <- dist2d(c(var[i], perplexity[i]), a, b)
28 
+    }
19 29
20 
-curveElbow = function(var, perplexity, pval.cutoff = 0.05) {
21 
-
22 
-  len = length(perplexity)
23 
-
24 
-  a = c(var[1], perplexity[1])
25 
-  b = c(var[len], perplexity[len])
26 
-  res = rep(NA, len)
27 
-  for(i in seq_along(var)) {
28 
-    res[i] = dist2d(c(var[i], perplexity[i]), a, b)
29 
-  }
30 
+    elbow <- which.max(res)
31 
+    ix <- var > var[elbow]
32 
+    perplexity.sde <- secondDerivativeEstimate(perplexity)
33 
+    perplexity.sde.sd <- stats::sd(perplexity.sde[ix], na.rm = TRUE)
34 
+    perplexity.sde.mean <-
35 
+        stats::mean(perplexity.sde[ix], na.rm = TRUE)
36 
+    perplexity.sde.pval <-
37 
+        stats::pnorm(
38 
+            perplexity.sde,
39 
+            mean = perplexity.sde.mean,
40 
+            sd = perplexity.sde.sd,
41 
+            lower.tail = FALSE
42 
+        )
30 43
31 
-  elbow = which.max(res)
32 
-  ix = var > var[elbow]
33 
-  perplexity.sde = secondDerivativeEstimate(perplexity)
34 
-  perplexity.sde.sd = stats::sd(perplexity.sde[ix], na.rm=TRUE)
35 
-  perplexity.sde.mean = stats::mean(perplexity.sde[ix], na.rm=TRUE)
36 
-  perplexity.sde.pval = stats::pnorm(perplexity.sde, mean=perplexity.sde.mean, sd=perplexity.sde.sd, lower.tail = FALSE)
37 
-
38 
-  other = which(ix & perplexity.sde.pval < pval.cutoff)
39 
-  return(list(elbow=var[elbow]))#, secondary=l[other]))
44 
+    other <- which(ix & perplexity.sde.pval < pval.cutoff)
45 
+    return(list(elbow = var[elbow])) # , secondary=l[other]))
40 46 
 }
Browse code

Add function definition for sd,pnorm,median

Yusuke Koga authored on 26/03/2019 21:23:14
Showing 1 changed files
R/elbow.R
History View file @ e5d3df28
... ... 
@@ -31,9 +31,9 @@ curveElbow = function(var, perplexity, pval.cutoff = 0.05) {
31 31 
   elbow = which.max(res)
32 32 
   ix = var > var[elbow]
33 33 
   perplexity.sde = secondDerivativeEstimate(perplexity)
34 
-  perplexity.sde.sd = sd(perplexity.sde[ix], na.rm=TRUE)
35 
-  perplexity.sde.mean = mean(perplexity.sde[ix], na.rm=TRUE)
36 
-  perplexity.sde.pval = pnorm(perplexity.sde, mean=perplexity.sde.mean, sd=perplexity.sde.sd, lower.tail = FALSE)
34 
+  perplexity.sde.sd = stats::sd(perplexity.sde[ix], na.rm=TRUE)
35 
+  perplexity.sde.mean = stats::mean(perplexity.sde[ix], na.rm=TRUE)
36 
+  perplexity.sde.pval = stats::pnorm(perplexity.sde, mean=perplexity.sde.mean, sd=perplexity.sde.sd, lower.tail = FALSE)
37 37
38 38 
   other = which(ix & perplexity.sde.pval < pval.cutoff)
39 39 
   return(list(elbow=var[elbow]))#, secondary=l[other]))
Browse code

Merging from compbiomed@devel

Sean Corbett authored on 18/03/2019 22:09:34
Showing 0 changed files
Browse code

Elbow method for choosing K/L from perplexity curve

Sean Corbett authored on 08/03/2019 16:53:45
Showing 1 changed files
R/elbow.R
History View file @ b881a0f0
1 1 
new file mode 100644
... ... 
@@ -0,0 +1,40 @@
1 
+# https://stackoverflow.com/questions/35194048/using-r-how-to-calculate-the-distance-from-one-point-to-a-line
2 
+# http://mathworld.wolfram.com/Point-LineDistance2-Dimensional.html
3 
+# Kimberling, C. "Triangle Centers and Central Triangles." Congr. Numer. 129, 1-295, 1998.
4 
+dist2d <- function(a,b,c) {
5 
+ v1 <- b - c
6 
+ v2 <- a - b
7 
+ m <- cbind(v1,v2)
8 
+ d <- abs(det(m))/sqrt(sum(v1*v1))
9 
+}
10 
+
11 
+secondDerivativeEstimate = function(v) {
12 
+  nv = length(v)
13 
+  res = rep(NA, nv)
14 
+  for(i in 2:(nv-1)) {
15 
+    res[i] = v[i+1] + v[i-1] - (2 * v[i])
16 
+  }
17 
+  return(res)
18 
+}
19 
+
20 
+curveElbow = function(var, perplexity, pval.cutoff = 0.05) {
21 
+
22 
+  len = length(perplexity)
23 
+
24 
+  a = c(var[1], perplexity[1])
25 
+  b = c(var[len], perplexity[len])
26 
+  res = rep(NA, len)
27 
+  for(i in seq_along(var)) {
28 
+    res[i] = dist2d(c(var[i], perplexity[i]), a, b)
29 
+  }
30 
+
31 
+  elbow = which.max(res)
32 
+  ix = var > var[elbow]
33 
+  perplexity.sde = secondDerivativeEstimate(perplexity)
34 
+  perplexity.sde.sd = sd(perplexity.sde[ix], na.rm=TRUE)
35 
+  perplexity.sde.mean = mean(perplexity.sde[ix], na.rm=TRUE)
36 
+  perplexity.sde.pval = pnorm(perplexity.sde, mean=perplexity.sde.mean, sd=perplexity.sde.sd, lower.tail = FALSE)
37 
+
38 
+  other = which(ix & perplexity.sde.pval < pval.cutoff)
39 
+  return(list(elbow=var[elbow]))#, secondary=l[other]))
40 
+}
0 41 
\ No newline at end of file
Browse code

Fixed error in example code for reursive split and removed export of curve elbow until we know we want to use it

Joshua D. Campbell authored on 08/03/2019 16:15:10
Showing 1 changed files
R/elbow.R
History View file @ b18317c2
... ... 
@@ -17,7 +17,6 @@ secondDerivativeEstimate = function(v) {
17 17 
   return(res)
18 18 
 }
19 19
20 
-#' @export
21 20 
 curveElbow = function(var, perplexity, pval.cutoff = 0.05) {
22 21
23 22 
   len = length(perplexity)
Browse code

Replace set.seed() with setSeed(). Fixes #37

Sean Corbett authored on 24/02/2019 22:33:31
Showing 1 changed files
R/elbow.R
History View file @ ad207a44
1 1 
new file mode 100755
... ... 
@@ -0,0 +1,41 @@
1 
+# https://stackoverflow.com/questions/35194048/using-r-how-to-calculate-the-distance-from-one-point-to-a-line
2 
+# http://mathworld.wolfram.com/Point-LineDistance2-Dimensional.html
3 
+# Kimberling, C. "Triangle Centers and Central Triangles." Congr. Numer. 129, 1-295, 1998.
4 
+dist2d <- function(a,b,c) {
5 
+ v1 <- b - c
6 
+ v2 <- a - b
7 
+ m <- cbind(v1,v2)
8 
+ d <- abs(det(m))/sqrt(sum(v1*v1))
9 
+}
10 
+
11 
+secondDerivativeEstimate = function(v) {
12 
+  nv = length(v)
13 
+  res = rep(NA, nv)
14 
+  for(i in 2:(nv-1)) {
15 
+    res[i] = v[i+1] + v[i-1] - (2 * v[i])
16 
+  }
17 
+  return(res)
18 
+}
19 
+
20 
+#' @export
21 
+curveElbow = function(var, perplexity, pval.cutoff = 0.05) {
22 
+
23 
+  len = length(perplexity)
24 
+
25 
+  a = c(var[1], perplexity[1])
26 
+  b = c(var[len], perplexity[len])
27 
+  res = rep(NA, len)
28 
+  for(i in seq_along(var)) {
29 
+    res[i] = dist2d(c(var[i], perplexity[i]), a, b)
30 
+  }
31 
+
32 
+  elbow = which.max(res)
33 
+  ix = var > var[elbow]
34 
+  perplexity.sde = secondDerivativeEstimate(perplexity)
35 
+  perplexity.sde.sd = sd(perplexity.sde[ix], na.rm=TRUE)
36 
+  perplexity.sde.mean = mean(perplexity.sde[ix], na.rm=TRUE)
37 
+  perplexity.sde.pval = pnorm(perplexity.sde, mean=perplexity.sde.mean, sd=perplexity.sde.sd, lower.tail = FALSE)
38 
+
39 
+  #other = which(ix & perplexity.sde.pval < pval.cutoff)
40 
+  return(list(elbow=var[elbow])) #, secondary=l[other]))
41 
+}