DynamicBleeding/fMeasure.R at main · stmilab/DynamicBleeding · GitHub

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
#This calculates the f-measure
library(foreach)
library(doParallel)
fscore <- function(tp, tn, fp, fn) {
  if(tp + fn == 0) {
    re <- 0
  } else {
    re <- (tp / (tp + fn))
  }
  if(tp + fp == 0) {
    pr <- 0
  } else {
    pr <- (tp / (tp + fp))
  }

  if(tn + fp == 0){
    spec <- 0
  } else {
    spec <- (tn / (tn + fp))
  }

  if(pr + re == 0)
  {
    f <- 0
    res <- data.frame(f, pr, re, spec)
    return(res)
  } else {
    f <- (2 * (pr * re) / (pr + re) )
    res <- data.frame(f, pr, re, spec)
    return( res )
  }
}

ratesOfPredict <- function(predicted, gt) {
  tp <- 0
  fp <- 0
  tn <- 0
  fn <- 0

  tp <- length(which((predicted == gt) & (predicted == 1)))
  tn <- length(which((predicted == gt) & (predicted == 0)))
  fp <- length(which((predicted != gt) & (predicted == 1)))
  fn <- length(which((predicted != gt) & (predicted == 0)))

  return(data.frame(tp, tn, fp, fn))
}

allROC_par <- function(response, gt) {

  #registerDoParallel()

  min.val <- min(response)
  max.val <- max(response)
  vals <- seq(min.val, max.val, (max.val - min.val)/100)
  max.f <- 0
  best.res <- NA
  best.val <- min.val
  all.vals <- foreach(i=1:length(vals), .combine=rbind) %dopar% {
    v <- vals[i]
    pred <- rep(0, length(response))
    pred[which(response >= v)] <- 1
    #values <- ratesOfPredict(pred, gt)
    tp <- 0
    fp <- 0
    tn <- 0
    fn <- 0

    tp <- length(which((pred == gt) & (pred == 1)))
    tn <- length(which((pred == gt) & (pred == 0)))
    fp <- length(which((pred != gt) & (pred == 1)))
    fn <- length(which((pred != gt) & (pred == 0)))

    if(tp + fn == 0) {
      re <- 0
    } else {
      re <- (tp / (tp + fn))
    }
    if(tp + fp == 0) {
      pr <- 0
    } else {
      pr <- (tp / (tp + fp))
    }

    if(tn + fp == 0){
      spec <- 0
    } else {
      spec <- (tn / (tn + fp))
    }

    if(pr + re == 0)
    {
      f.score <- 0
      #res <- data.frame(f, pr, re, spec)
      #return(res)
    } else {
      f.score <- (2 * (pr * re) / (pr + re) )
      #res <- data.frame(f, pr, re, spec)
      #return( res )
    }

    #results <- fscore(values$tp, values$tn, values$fp, values$fn)
    data.frame(min.val, max.val, v, tp, tn, fp, fn, pr, re, spec, f.score)
  }

  best.res <- all.vals[which(all.vals$f.score == max(all.vals$f.score)),]

  res.final <- list()
  res.final[[1]] <- best.res
  res.final[[2]] <- all.vals
  return(res.final)
}