-
Notifications
You must be signed in to change notification settings - Fork 0
/
3. Support functions.R
126 lines (101 loc) · 3.56 KB
/
3. Support functions.R
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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
# Libraries
library(mxnet)
library(data.table)
library(magrittr)
# Custom functions
IoU_function <- function (label, pred) {
overlap_width <- min(label[,2], pred[,2]) - max(label[,1], pred[,1])
overlap_height <- min(label[,3], pred[,3]) - max(label[,4], pred[,4])
if (overlap_width > 0 & overlap_height > 0) {
pred_size <- (pred[,2]-pred[,1])*(pred[,3]-pred[,4])
label_size <- (label[,2]-label[,1])*(label[,3]-label[,4])
overlap_size <- overlap_width * overlap_height
return(overlap_size/(pred_size + label_size - overlap_size))
} else {
return(0)
}
}
# Based on https://github.com/rafaelpadilla/Object-Detection-Metrics
AP_function <- function (obj_IoU, obj_prob, num_obj, IoU_cut = 0.5) {
sort_obj_IoU <- obj_IoU[order(obj_prob, decreasing=TRUE)]
pred_postive <- sort_obj_IoU > IoU_cut
cum_TP <- cumsum(pred_postive)
P_list <- cum_TP * pred_postive / seq_along(pred_postive)
P_list <- P_list[P_list!=0]
while (sum(diff(P_list) > 0) >= 1) {
diff_P_list <- diff(P_list)
diff_P_list[diff_P_list < 0] <- 0
P_list <- P_list + c(diff_P_list, 0)
}
return(sum(P_list)/num_obj)
}
# Custom callback function
my.eval.metric.loss <- mx.metric.custom(
name = "multi_part_loss",
function(label, pred) {
return(as.array(pred))
}
)
my.callback_batch <- function (batch.size = 16, frequency = 10) {
function(iteration, nbatch, env, verbose = TRUE) {
count <- nbatch
if (is.null(env$count))
env$count <- 0
if (is.null(env$init))
env$init <- FALSE
if (env$count > count)
env$init <- FALSE
env$count = count
if (env$init) {
if (count%%frequency == 0 && !is.null(env$metric)) {
time <- as.double(difftime(Sys.time(), env$tic,
units = "secs"))
speed <- frequency * batch.size/time
result <- env$metric$get(env$train.metric)
if (nbatch != 0 & verbose) {
message(paste0("Batch [", nbatch, "] Speed: ",
formatC(speed, 3, format = "f"), " samples/sec Train-", result$name,
"=", as.array(result$value)))
}
env$tic = Sys.time()
}
}
else {
env$init <- TRUE
env$tic <- Sys.time()
}
}
}
my.callback_epoch <- function (out_symbol, logger = NULL,
prefix = 'model/yolo model (pikachu)/yolo_v1',
fixed.params = NULL,
period = 1) {
function(iteration, nbatch, env, verbose = TRUE) {
if (iteration%%period == 0) {
env_model <- env$model
env_all_layers <- env_model$symbol$get.internals()
model_write_out <- list(symbol = out_symbol,
arg.params = env_model$arg.params,
aux.params = env_model$aux.params)
model_write_out[[2]] <- append(model_write_out[[2]], fixed.params)
class(model_write_out) <- "MXFeedForwardModel"
mx.model.save(model_write_out, prefix, iteration)
if (verbose) {
message(sprintf("Model checkpoint saved to %s-%04d.params", prefix, iteration))
}
}
if (!is.null(logger)) {
if (class(logger) != "mx.metric.logger") {
stop("Invalid mx.metric.logger.")
} else {
result <- env$metric$get(env$train.metric)
logger$train <- c(logger$train, result$value)
if (!is.null(env$eval.metric)) {
result <- env$metric$get(env$eval.metric)
logger$eval <- c(logger$eval, result$value)
}
}
}
return(TRUE)
}
}