# packages deepnet, nnet, stats are only used within the pretrained models
# hence the R check generates a note:
# "Namespace in Imports field not imported from"
# following import-from would avoid the note
#' @importFrom deepnet nn.predict nn.train
NULL
#' @importFrom nnet class.ind
NULL
#' @importFrom stats prcomp
NULL
#' @importFrom magrittr %>%
NULL
rgb_dist <- function(arr, color)
{
# Compute cell-wise distance between array and a color
#
# args:
# arr: array of size (3, nrow, ncol)
# color: vector of size 3
#
# return:
# matrix of size (nrow, ncol)
#
# Note:
# distance is computed by weighted Euclidean distance
# with weight [2,4,9]
# https://en.wikipedia.org/wiki/Color_difference
stopifnot(is.array(arr))
stopifnot(length(dim(arr))==3)
stopifnot(dim(arr)[1]==3)
if (length(color)!=3) color <- rep(color, length=3)
R <- 2/9*((arr[1,,] - color[1])^2)
G <- 4/9*((arr[2,,] - color[2])^2)
B <- 3/9*((arr[3,,] - color[3])^2)
sqrt(R+G+B)
# old implementation, slower
#apply(((arr-color)^2)*c(2/9, 4/9, 3/9),
# FUN=sum, MARGIN=c(2,3))^0.5
}
image_plot <- function(arr, show=FALSE, eps=1e-10)
{
# Create graphic object of an image
#
# args:
# arr: array of size either (3, nrow, ncol) or (nrow, ncol).
# the former is RGB and the latter gray scale
# show: if TRUE, show image
# eps: very small value shifted to avoid rgb range error
#
# returns:
# ggplot
if (length(dim(arr))==3) {
# change to channel-last order
arr <- aperm(arr, c(2,3,1))
} else {
x <- range(arr, na.rm=TRUE) + c(-eps, +eps)
y <- c(max(x[1], 0), min(x[2], 1))
b <- diff(y)/diff(x)
a <- y[1]-b*x[1]
arr <- a + b*arr
# truncate to [0,1]
#arr[arr > 1] <- 1
#arr[arr < 0] <- 0
}
out <- grid::rasterGrob(arr)
# put the graphic on ggplot
out <- ggplot2::qplot(0.5, 0.5, xlim=c(0,1), ylim=c(0,1)) +
ggplot2::theme_void() + ggplot2::xlab('') + ggplot2::ylab('') +
ggplot2::annotation_custom(out)
if (show) graphics::plot(out)
invisible(out)
}
to_gray <- function(arr, white, black)
{
# Make RGB image into gray scale
#
# args:
# arr: array of size (3, nrow, ncol)
# white: vector of size 3
# black: vector of size 3
#
# return:
# matrix of size (nrow, ncol)
weights <- c(2/9, 4/9, 3/9)^0.5
white <- white * weights
black <- black * weights
arr <- arr * weights
denom <- as.numeric(crossprod(black - white))
# old ver. maybe slightly slower?
#out <- apply(arr - black, MARGIN=c(2,3), FUN=crossprod, y=white - black)
tmp <- (arr-black) * (white-black)
out <- tmp[1,,] + tmp[2,,] + tmp[3,,]
out/denom
}
detect_consecutive_true <- function(arr)
{
# Find start/end indices of consecutive true's
#
# args:
# arr: logical vector
#
# return:
# matrix of two columns, start and end
stopifnot(is.logical(arr))
if (length(arr)==0) return(NULL)
L <- length(arr)
start <- which(arr & !c(FALSE, utils::head(arr, L-1)))
end <- which(arr & !c(utils::tail(arr, L-1), FALSE))
stopifnot(length(start) == length(end))
cbind(start, end)
}
detect_consecutive_false <- function(arr)
{
detect_consecutive_true(!arr)
}
pad_crop_image <- function(arr, target_rows, target_cols, value)
{
# Pad and/of crop image to target size
#
# args:
# arr: array of size (3, nrow, ncol) or matrix of size (nrow, ncol)
# target_rows, target_cols: output shape
# value: value to pad
#
# returns:
# array of matrix with target size
original_dim <- dim(arr)
if (length(dim(arr)) == 2) arr <- array(arr, dim=c(1, dim(arr)))
stopifnot(length(value) == dim(arr)[1])
rows_toadd <- target_rows - dim(arr)[2]
if (rows_toadd >= 0) {
top <- 1 + (rows_toadd %/% 2)
bottom <- top - 1 + dim(arr)[2]
} else {
# crop rows
i1 <- -rows_toadd %/% 2
i2 <- i1 + target_rows-1
arr <- arr[,i1:i2,, drop=FALSE]
top <- 1
bottom <- dim(arr)[2]
}
cols_toadd <- target_cols - dim(arr)[3]
if (cols_toadd >= 0) {
left <- 1 + (cols_toadd %/% 2)
right <- left - 1 + dim(arr)[3]
} else {
# crop cols
j1 <- -cols_toadd %/% 2
j2 <- j1 + target_cols-1
arr <- arr[,,j1:j2, drop=FALSE]
left <- 1
right <- dim(arr)[3]
}
out <- array(value, dim=c(dim(arr)[1], target_rows, target_cols))
out[,top:bottom,left:right] <- arr
if (length(original_dim)==2) out <- drop(out)
out
}
str_to_num_rank <- function(s)
{
# convert str rating to numeric
#
# args:
# s: character vector of ratings, such as 3d, 2k
#
# returns:
# integer vector. NA for invalid strings
#
# note:
# 2d=1, 1d=0, 1k=-1, 2k=-2 ...,
# i.e., dan's are positive and kyu's are negative
tmp <- stringr::str_match(s, '([0-9]+)([dk])')
n <- as.integer(tmp[,2])
l <- tmp[,3]
n[which(l=='k')] <- -n[which(l=='k')]
n[which(l=='d')] <- n[which(l=='d')] - 1
n
}
num_to_str_rank <- function(n)
{
# convert numeric rating to str
#
# args:
# n: numeric vector
#
# returns:
# character vector
s <- rep(NA_character_, length(n))
s[which(n<0)] <- paste(-n[which(n<0)], 'k', sep='')
s[which(n>=0)] <- paste(1+n[which(n>=0)], 'd', sep='')
s
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.