# GPU vector pmax/pmin
gpuMatpmax <- function(..., order){
thresholds <- list(...)
A <- thresholds[[1]]
# remove from list
thresholds[[1]] <- NULL
type <- typeof(A)
# B <- vclVector(length = length(A), type=type, ctx_id = A@.context_index)
B <- deepcopy(A)
maxWorkGroupSize <-
switch(deviceType(B@.device_index, B@.context_index),
"gpu" = gpuInfo(B@.device_index, B@.context_index)$maxWorkGroupSize,
"cpu" = cpuInfo(B@.device_index, B@.context_index)$maxWorkGroupSize,
stop("unrecognized device type")
)
kernel <- switch(type,
integer = {
if(order == 1L){
file <- system.file("CL", "iMat_pmax.cl", package = "gpuR")
}else{
file <- system.file("CL", "iMat_pmin.cl", package = "gpuR")
}
if(!file_test("-f", file)){
stop("kernel file does not exist")
}
readChar(file, file.info(file)$size)
},
float = {
if(order == 1L){
file <- system.file("CL", "fMat_pmax.cl", package = "gpuR")
}else{
file <- system.file("CL", "fMat_pmin.cl", package = "gpuR")
}
if(!file_test("-f", file)){
stop("kernel file does not exist")
}
readChar(file, file.info(file)$size)
},
double = {
if(order == 1L){
file <- system.file("CL", "dMat_pmax.cl", package = "gpuR")
}else{
file <- system.file("CL", "dMat_pmin.cl", package = "gpuR")
}
if(!file_test("-f", file)){
stop("kernel file does not exist")
}
readChar(file, file.info(file)$size)
},
stop("type not recognized")
)
for(threshold in thresholds){
switch(type,
integer = {
cpp_vclMatrix_pmax(B@address,
is(B, "vclMatrix"),
B@address,
is(B, "vclMatrix"),
threshold,
kernel,
sqrt(maxWorkGroupSize),
4L,
A@.context_index - 1L)
},
float = {
cpp_vclMatrix_pmax(B@address,
is(B, "vclMatrix"),
B@address,
is(B, "vclMatrix"),
threshold,
kernel,
sqrt(maxWorkGroupSize),
6L,
A@.context_index - 1L)
},
double = {
cpp_vclMatrix_pmax(B@address,
is(B, "vclMatrix"),
B@address,
is(B, "vclMatrix"),
threshold,
kernel,
sqrt(maxWorkGroupSize),
8L,
A@.context_index - 1L)
}
)
}
return(B)
}
# GPU vector pmax/pmin
gpuVecpmax <- function(..., order){
thresholds <- list(...)
A <- thresholds[[1]]
# remove from list
thresholds[[1]] <- NULL
type <- typeof(A)
# B <- vclVector(length = length(A), type=type, ctx_id = A@.context_index)
B <- deepcopy(A)
maxWorkGroupSize <-
switch(deviceType(B@.device_index, B@.context_index),
"gpu" = gpuInfo(B@.device_index, B@.context_index)$maxWorkGroupSize,
"cpu" = cpuInfo(B@.device_index, B@.context_index)$maxWorkGroupSize,
stop("unrecognized device type")
)
kernel <- switch(type,
integer = {
if(order == 1L){
file <- system.file("CL", "iVec_pmax.cl", package = "gpuR")
}else{
file <- system.file("CL", "iVec_pmin.cl", package = "gpuR")
}
if(!file_test("-f", file)){
stop("kernel file does not exist")
}
readChar(file, file.info(file)$size)
},
float = {
if(order == 1L){
file <- system.file("CL", "fVec_pmax.cl", package = "gpuR")
}else{
file <- system.file("CL", "fVec_pmin.cl", package = "gpuR")
}
if(!file_test("-f", file)){
stop("kernel file does not exist")
}
readChar(file, file.info(file)$size)
},
double = {
if(order == 1L){
file <- system.file("CL", "dVec_pmax.cl", package = "gpuR")
}else{
file <- system.file("CL", "dVec_pmin.cl", package = "gpuR")
}
if(!file_test("-f", file)){
stop("kernel file does not exist")
}
readChar(file, file.info(file)$size)
},
stop("type not recognized")
)
for(threshold in thresholds){
switch(type,
integer = {
cpp_vclVector_pmax(B@address,
is(B, "vclVector"),
B@address,
is(B, "vclVector"),
threshold,
kernel,
maxWorkGroupSize,
4L,
A@.context_index - 1L)
},
float = {
cpp_vclVector_pmax(B@address,
is(B, "vclVector"),
B@address,
is(B, "vclVector"),
threshold,
kernel,
maxWorkGroupSize,
6L,
A@.context_index - 1L)
},
double = {
cpp_vclVector_pmax(B@address,
is(B, "vclVector"),
B@address,
is(B, "vclVector"),
threshold,
kernel,
maxWorkGroupSize,
8L,
A@.context_index - 1L)
}
)
}
return(B)
}
#' @title 'Parallel' Maxima and Minima
#' @description \code{pmax} and \code{pmin} take one or more
#' vectors as arguments and return a single vector giving the 'parallel'
#' maxima (or minima) of the argument vectors
#' @param ... gpuR or numeric arguments
#' @seealso \link[base]{pmax} \link[base]{pmin}
#' @rdname pmax
#' @export
pmax <- function(...){ UseMethod("pmax") }
#' @export
pmax.default <- function(..., na.rm=FALSE){ base::pmax(..., na.rm=FALSE) }
#' @rdname pmax
#' @export
pmin <- function(...){ UseMethod("pmin") }
#' @export
pmin.default <- function(..., na.rm=FALSE){ base::pmin(..., na.rm=FALSE) }
#' @export
pmax.vclVector <- function(..., na.rm = FALSE){
gpuVecpmax(..., order = 1L)
}
#' @export
pmax.vclMatrix <- function(..., na.rm = FALSE){
gpuMatpmax(..., order = 1L)
}
#' @export
pmax.gpuVector <- function(..., na.rm = FALSE){
gpuVecpmax(..., order = 1L)
}
#' @export
pmax.gpuMatrix <- function(..., na.rm = FALSE){
gpuMatpmax(..., order = 1L)
}
#' # @rdname
#' setGeneric("pmax", signature = "...")
#'
#' # @rdname
#' #' @method pmax vclVector
#' #' @export
#' setMethod("pmax",
#' "vclVector",
#' function(..., na.rm = FALSE){
#' print("called correctly")
#' gpuVecpmax(..., order = 1L)
#' })
#'
#' #' @export
#' setMethod("pmax",
#' "vclMatrix",
#' function(..., na.rm = FALSE){
#' gpuMatpmax(..., order = 1L)
#' })
#'
#' #' @export
#' setMethod("pmax",
#' "gpuVector",
#' function(..., na.rm = FALSE){
#' gpuVecpmax(..., order = 1L)
#' })
#'
#' #' @export
#' setMethod("pmax",
#' "gpuMatrix",
#' function(..., na.rm = FALSE){
#' gpuMatpmax(..., order = 1L)
#' })
#' @param ... a vclVector object
#' @param na.rm a logical indicating whether missing values should be removed.
#' @export
pmin.vclVector <- function(..., na.rm = FALSE){
gpuVecpmax(..., order = -1L)
}
#' @export
pmin.vclMatrix <- function(..., na.rm = FALSE){
gpuMatpmax(..., order = -1L)
}
#' @export
pmin.gpuVector <- function(..., na.rm = FALSE){
gpuVecpmax(..., order = -1L)
}
#' @export
pmin.gpuMatrix <- function(..., na.rm = FALSE){
gpuMatpmax(..., order = -1L)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.