├── .Rbuildignore ├── .gitignore ├── inst └── doc │ └── Introduction.pdf ├── man ├── names-methods.Rd ├── which-methods.Rd ├── sort-methods.Rd ├── show-methods.Rd ├── ncol-methods.Rd ├── t-methods.Rd ├── gtest.Rd ├── dimnames-methods.Rd ├── length-methods.Rd ├── max-methods.Rd ├── dim-methods.Rd ├── diag-methods.Rd ├── mean-methods.Rd ├── checkDevice.Rd ├── chol.Rd ├── gvector.Rd ├── ifelse-methods.Rd ├── ggc.Rd ├── gsumby.Rd ├── gident.Rd ├── rsample.Rd ├── gnamestrip.Rd ├── device-methods.Rd ├── gRowLogSums.Rd ├── colnames-methods.Rd ├── gset.seed.Rd ├── gmatTimesDiagVec.Rd ├── setTuningPameters.Rd ├── lpgr-class.Rd ├── colMeans-methods.Rd ├── gkroneckerProd.Rd ├── gseq.Rd ├── beta.Rd ├── type.Rd ├── poisson.Rd ├── binomial.Rd ├── gorder.Rd ├── gmm.Rd ├── uniform.Rd ├── convertType.Rd ├── gdup.Rd ├── as.numeric-methods.Rd ├── g.rep.Rd ├── gamma.Rd ├── gsvd-class.Rd ├── setDevice.Rd ├── gouter.Rd ├── gmatrix-internal.Rd ├── indexing-methods.Rd ├── gqr-class.Rd ├── g.Rd ├── mm-methods.Rd ├── gmatrix.Rd ├── normal.Rd ├── as.gmatrix-methods.Rd ├── gmatrix-package.Rd ├── crossprod-methods.Rd ├── MathMethods.Rd ├── gBasicHMC.Rd └── BinaryOperators-methods.Rd ├── cleanup ├── src ├── Makefile.in ├── conversions.cu └── general.cu ├── DESCRIPTION ├── LICENSE ├── NAMESPACE ├── configure.ac ├── README.md ├── R ├── 06solve.R ├── 07MCMC.R ├── 00general.R ├── 03dist.R └── 02gvector.R └── tools ├── mdate-sh ├── missing └── install-sh /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | src/*.o 5 | src/*.so 6 | src/*.dll 7 | -------------------------------------------------------------------------------- /inst/doc/Introduction.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/njm18/gmatrix/HEAD/inst/doc/Introduction.pdf -------------------------------------------------------------------------------- /man/names-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{names} 2 | \docType{methods} 3 | \alias{names-methods} 4 | \alias{names,gvector-method} 5 | \alias{names<--methods} 6 | \alias{names<-,gvector-method} 7 | \title{Get and set names} 8 | \description{ 9 | Gets and sets the names slot of a \code{gvector} object. 10 | } 11 | \section{Methods}{ 12 | \describe{ 13 | \item{\code{signature(x = "gvector")}}{} 14 | }} 15 | \keyword{methods} -------------------------------------------------------------------------------- /man/which-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{which} 2 | \docType{methods} 3 | \alias{which-methods} 4 | \alias{which,ANY-method} 5 | \alias{which,gvector-method} 6 | \title{Which indices are TRUE?} 7 | \description{ 8 | Give the TRUE indices of a logical \code{gvector}. 9 | } 10 | \section{Methods}{ 11 | \describe{ 12 | 13 | \item{\code{signature(x = "ANY")}}{} 14 | 15 | \item{\code{signature(x = "gvector")}}{} 16 | }} 17 | \keyword{methods} -------------------------------------------------------------------------------- /man/sort-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{sort} 2 | \docType{methods} 3 | \alias{sort-methods} 4 | \alias{sort,ANY-method} 5 | \alias{sort,gvector-method} 6 | \alias{sort,jarrayRef-method} 7 | \alias{sort,jrectRef-method} 8 | \title{Sorting} 9 | \description{ 10 | Sorts a vector 11 | } 12 | \section{Methods}{ 13 | \describe{ 14 | \item{\code{signature(x = "ANY")}}{} 15 | \item{\code{signature(x = "gvector")}}{} 16 | }} 17 | \keyword{methods} 18 | 19 | -------------------------------------------------------------------------------- /man/show-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{show} 2 | \docType{methods} 3 | \alias{show-methods} 4 | \alias{show,gmatrix-method} 5 | \alias{show,gvector-method} 6 | \title{Methods for displaying GPU objects} 7 | \description{ 8 | These methods may be used to display objects of class \code{gmatrix} and 'gvector.' 9 | } 10 | \section{Methods}{ 11 | \describe{ 12 | \item{\code{signature(object = "gmatrix")}}{} 13 | \item{\code{signature(object = "gvector")}}{} 14 | }} 15 | \keyword{methods} 16 | 17 | -------------------------------------------------------------------------------- /cleanup: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # This script was modified from 3 | # the 'magma' R package by Brian Smith which is licensed by 4 | # under GNU GPL 3 or later. 5 | 6 | # Cleans up after the auxiliary files that were created when installing 7 | # the gmatrix package 8 | # 9 | echo "Cleaning up after installing the gmatrix package" 10 | 11 | for f in config.log config.status config.cache ; do 12 | if test -w $f ; then 13 | rm -f $f 14 | fi 15 | done 16 | 17 | cd src 18 | make clean 19 | rm -f Makefile 20 | 21 | -------------------------------------------------------------------------------- /man/ncol-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{ncol} 2 | \docType{methods} 3 | \alias{ncol-methods} 4 | \alias{ncol,ANY-method} 5 | \alias{ncol,gmatrix-method} 6 | \alias{nrow-methods} 7 | \alias{nrow,ANY-method} 8 | \alias{nrow,gmatrix-method} 9 | 10 | \title{Mumber of rows/columns} 11 | \description{ 12 | Get the number of rows/columns of a 'gmatrix.' 13 | } 14 | \section{Methods}{ 15 | \describe{ 16 | \item{\code{signature(x = "ANY")}}{} 17 | 18 | \item{\code{signature(x = "gmatrix")}}{} 19 | }} 20 | \keyword{methods} 21 | 22 | -------------------------------------------------------------------------------- /man/t-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{t} 2 | \docType{methods} 3 | \alias{t-methods} 4 | \alias{t,ANY-method} 5 | \alias{t,gmatrix-method} 6 | \alias{t,gvector-method} 7 | \alias{t.gmatrix} 8 | \alias{t.gvector} 9 | \title{Transpose} 10 | \description{ 11 | Methods to traspose a \code{gmatrix} or \code{gvector}. 12 | } 13 | \section{Methods}{ 14 | \describe{ 15 | \item{\code{signature(x = "ANY")}}{} 16 | \item{\code{signature(x = "gmatrix")}}{} 17 | \item{\code{signature(x = "gvector")}}{} 18 | }} 19 | \keyword{methods} 20 | 21 | -------------------------------------------------------------------------------- /man/gtest.Rd: -------------------------------------------------------------------------------- 1 | \name{gtest} 2 | \alias{gtest} 3 | 4 | 5 | \title{ 6 | Testing 7 | } 8 | \description{ 9 | This function performs a large number of tests to determine if the package is working properly. Any problems are printed to the screen. It is recomended to be run at least once after installation. 10 | } 11 | \usage{ 12 | gtest() 13 | } 14 | 15 | %\arguments{ 16 | % \item{A}{A \code{gmatrix}, \code{gvector}, \code{matrix} or \code{vector}} 17 | %} 18 | \value{ 19 | TRUE 20 | } 21 | \author{ 22 | Nathan Morris 23 | } 24 | -------------------------------------------------------------------------------- /man/dimnames-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{dimnames} 2 | \docType{methods} 3 | \alias{dimnames-methods} 4 | \alias{dimnames,gmatrix-method} 5 | \alias{dimnames<--methods} 6 | \alias{dimnames<-,gmatrix-method} 7 | \title{Dimnames of an Object} 8 | \description{ 9 | Retrieve or set the dimnames of an object. Implemented much the same as R base. 10 | } 11 | \section{Methods}{ 12 | \describe{ 13 | \item{\code{signature(x = "gmatrix")}}{} 14 | }} 15 | \keyword{methods} 16 | \seealso{ 17 | \code{\link[base:base-package]{dimnames}}, \code{\link{colnames}} 18 | } 19 | 20 | -------------------------------------------------------------------------------- /man/length-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{length} 2 | \docType{methods} 3 | \alias{length-methods} 4 | \alias{length,gmatrix-method} 5 | \alias{length,gvector-method} 6 | 7 | \title{Length of an Object} 8 | \description{ 9 | Get the length of a \code{gvector} or \code{gmatrix}. 10 | } 11 | \section{Methods}{ 12 | \describe{ 13 | \item{\code{signature(x = "gmatrix")}}{ 14 | returns total number of elements in the matrix. 15 | } 16 | \item{\code{signature(x = "gvector")}}{ 17 | returns the length of the \code{gvector} 18 | } 19 | }} 20 | \keyword{methods} 21 | 22 | -------------------------------------------------------------------------------- /man/max-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{max} 2 | \docType{methods} 3 | \alias{max-methods} 4 | \alias{max,gmatrix-method} 5 | \alias{max,gvector-method} 6 | \alias{min-methods} 7 | \alias{min,gmatrix-method} 8 | \alias{min,gvector-method} 9 | \title{Maxima and Minima} 10 | \description{ 11 | Returns the maxima and minima of the input values. The \code{na.rm=TRUE} option has NOT been implemented. 12 | } 13 | \section{Methods}{ 14 | \describe{ 15 | \item{\code{signature(x = "gmatrix")}}{} 16 | \item{\code{signature(x = "gvector")}}{} 17 | }} 18 | \keyword{methods} 19 | 20 | -------------------------------------------------------------------------------- /man/dim-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{dim} 2 | \docType{methods} 3 | \alias{dim-methods} 4 | \alias{dim,gmatrix-method} 5 | \alias{dim<--methods} 6 | \alias{dim<-,gmatrix-method} 7 | 8 | \title{Dimensions of an Object} 9 | \description{ 10 | Retrieve or set the dimension of an object. Implemented much the same as in R base. However, any redimensioning of a matrix must result in a matrix with the same number of elements. 11 | } 12 | \section{Methods}{ 13 | \describe{ 14 | \item{\code{signature(x = "gmatrix")}}{} 15 | }} 16 | \keyword{methods} 17 | \seealso{ 18 | \code{\link[base:base-package]{dim}} 19 | } 20 | -------------------------------------------------------------------------------- /src/Makefile.in: -------------------------------------------------------------------------------- 1 | # Compilers 2 | NVCC = @NVCC@ 3 | 4 | # Program-specifics 5 | OBJS = fact.o dist.o conversions.o general.o ops.o manipulation.o matrix.o 6 | TARGET = gmatrix.so 7 | 8 | # Compiler options 9 | FLAGS = @NCFLAGS@ 10 | 11 | # linker options 12 | LDFLAGS = @LDFLAGS@ 13 | LIBS = @LIBS@ 14 | 15 | # Build rules 16 | .SUFFIXES: .c .cu .o 17 | 18 | all: $(TARGET) 19 | 20 | $(TARGET): $(OBJS) 21 | $(NVCC) $(LDFLAGS) $(LIBS) $(OBJS) -o $@ 22 | 23 | %.o: %.c 24 | $(NVCC) -c $(FLAGS) $< -o $@ 25 | 26 | %.o: %.cu 27 | $(NVCC) -c $(FLAGS) $< -o $@ 28 | 29 | clean: 30 | rm -rf $(OBJS) $(TARGET) 31 | 32 | -------------------------------------------------------------------------------- /man/diag-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{diag} 2 | \docType{methods} 3 | \alias{diag-methods} 4 | \alias{diag,ANY-method} 5 | \alias{diag,gmatrix-method} 6 | \alias{diag,gvector-method} 7 | \alias{diag<--methods} 8 | \alias{diag<-,ANY-method} 9 | \alias{diag<-,gmatrix-method} 10 | 11 | \title{Matrix Diagonals} 12 | \description{ 13 | Extract or replace the diagonal of a matrix, or construct a diagonal matrix. Implemented much the same as in R base. 14 | } 15 | \section{Methods}{ 16 | \describe{ 17 | \item{\code{signature(x = "ANY")}}{} 18 | \item{\code{signature(x = "gmatrix")}}{} 19 | }} 20 | \keyword{methods} 21 | 22 | -------------------------------------------------------------------------------- /man/mean-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{mean, sum} 2 | \docType{methods} 3 | \alias{mean-methods} 4 | \alias{mean,ANY-method} 5 | \alias{mean,gmatrix-method} 6 | \alias{mean,gvector-method} 7 | 8 | \alias{sum-methods} 9 | \alias{sum,gmatrix-method} 10 | \alias{sum,gvector-method} 11 | 12 | \title{mean and sum methods} 13 | \description{ 14 | These methods are implement very similarly to the corresponding R base methods. 15 | } 16 | \section{Methods}{ 17 | \describe{ 18 | \item{\code{signature(x = "ANY")}}{} 19 | \item{\code{signature(x = "gmatrix")}}{} 20 | \item{\code{signature(x = "gvector")}}{} 21 | }} 22 | \keyword{methods} 23 | 24 | -------------------------------------------------------------------------------- /man/checkDevice.Rd: -------------------------------------------------------------------------------- 1 | \name{checkDevice} 2 | \alias{checkDevice} 3 | \title{ 4 | Check that the specified integer is the current device. 5 | } 6 | \description{ 7 | Mostly for internal uses. 8 | } 9 | \usage{ 10 | checkDevice(x) 11 | } 12 | 13 | \arguments{ 14 | \item{x}{ 15 | A vector of integers 16 | } 17 | } 18 | \details{ 19 | Errors out if x is not the current device. 20 | } 21 | \value{ 22 | Returns TRUE or errors out. 23 | } 24 | 25 | \author{ 26 | Nathan Morris 27 | } 28 | 29 | \seealso{ 30 | \code{\link{getDevice}}, \code{\link{setDevice}} and \code{\link{device}} 31 | } 32 | 33 | 34 | \keyword{ device } 35 | 36 | -------------------------------------------------------------------------------- /man/chol.Rd: -------------------------------------------------------------------------------- 1 | \name{chol} 2 | \docType{methods} 3 | \alias{chol-methods} 4 | \alias{chol,ANY-method} 5 | \alias{chol,gmatrix-method} 6 | 7 | \title{Method to calculate the Choleski decomposition square symmetric posative definite matrix} 8 | \description{ 9 | Takes a square symmetric posative definite \code{gmatrix} object. Note that no checking for symmetry is done. An error will be thrown if the the matrix is not posative definite. Returns a \code{gmatrix} object that is upper triangular. 10 | } 11 | \section{Methods}{ 12 | \describe{ 13 | \item{\code{signature(x = "ANY")}}{} 14 | \item{\code{signature(x = "gmatrix")}}{} 15 | }} 16 | \keyword{methods} 17 | 18 | -------------------------------------------------------------------------------- /man/gvector.Rd: -------------------------------------------------------------------------------- 1 | \name{gvector} 2 | \alias{gvector} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ 5 | Create a \code{gvector} object 6 | } 7 | \description{ 8 | Creates a gvector object of given length and initializes all elements to 0. 9 | } 10 | \usage{ 11 | gvector(length, type = "d") 12 | } 13 | \arguments{ 14 | \item{length}{length of the object} 15 | \item{type}{The type (i.e. \code{"double"}, \code{"single"}, \code{"integer"} or \code{"logical"})} 16 | } 17 | 18 | \value{ 19 | Returns a \code{gvector} object. 20 | } 21 | 22 | \author{ 23 | Nathan Morris 24 | } 25 | 26 | \seealso{ 27 | \code{\link{vector}} 28 | } 29 | 30 | -------------------------------------------------------------------------------- /man/ifelse-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{ifelse} 2 | \docType{methods} 3 | \alias{ifelse-methods} 4 | \alias{ifelse,ANY-method} 5 | \alias{ifelse,gmatrix-method} 6 | \alias{ifelse,gvector-method} 7 | \title{Conditional Element Selection} 8 | \description{ 9 | \code{ifelse} returns a value with the same shape as test which is filled with elements selected from either \code{yes} or \code{no} depending on whether the element of test is \code{TRUE} or \code{FALSE}. 10 | } 11 | \section{Methods}{ 12 | \describe{ 13 | \item{\code{signature(test = "ANY")}}{} 14 | \item{\code{signature(test = "gmatrix")}}{} 15 | \item{\code{signature(test = "gvector")}}{} 16 | }} 17 | \keyword{methods} 18 | 19 | -------------------------------------------------------------------------------- /man/ggc.Rd: -------------------------------------------------------------------------------- 1 | \name{ggc} 2 | \alias{ggc} 3 | \title{ 4 | GPU Garbage Collection 5 | } 6 | \description{ 7 | Performs Garbage Collection and reports the available memory. 8 | } 9 | \usage{ 10 | ggc(silent=FALSE) 11 | } 12 | \arguments{ 13 | \item{silent}{If silent is TRUE then nothing will be printed out.} 14 | } 15 | 16 | \details{ 17 | Used for garbage collection, and also used to discover the amount of memory on the graphics card which is still available. 18 | } 19 | \value{ 20 | returns TRUE, but prints the amount of memory left. 21 | } 22 | 23 | \author{ 24 | Nathan Morris 25 | } 26 | 27 | 28 | \seealso{ 29 | \code{\link{gc}} 30 | } 31 | \examples{ 32 | ggc() 33 | } 34 | \keyword{Garbage} 35 | 36 | -------------------------------------------------------------------------------- /man/gsumby.Rd: -------------------------------------------------------------------------------- 1 | \name{gsumby} 2 | \alias{gsumby} 3 | \title{ 4 | Sumby 5 | } 6 | \description{ 7 | Find sub-sums of a \code{gvector} 8 | } 9 | \usage{ 10 | gsumby(v, startPos, stopPos) 11 | } 12 | %- maybe also 'usage' for other objects documented here. 13 | \arguments{ 14 | \item{v}{a \code{gvector}} 15 | \item{startPos}{a vector of start positions} 16 | \item{stopPos}{a vector of stop positions} 17 | } 18 | \details{ 19 | \code{startPos} and \code{stopPos} must be of the same length. 20 | } 21 | \value{ 22 | returns a \code{gvector} object of the same length as \code{startPos} and \code{stopPos}. Each element is the sum of elements in \code{v}. 23 | } 24 | 25 | \author{ 26 | Nathan Morris 27 | } 28 | 29 | 30 | \examples{ 31 | gsumby(g(1:10), c(1,6), c(5,10)) # g(c(15,40)) 32 | } 33 | -------------------------------------------------------------------------------- /man/gident.Rd: -------------------------------------------------------------------------------- 1 | \name{gident} 2 | \alias{gident} 3 | \title{ 4 | Create an identity matrix on the GPU. 5 | } 6 | \description{Create an identity matrix on the GPU size} 7 | \usage{ 8 | gident(n,val=1, type="d") 9 | 10 | } 11 | %- maybe also 'usage' for other objects documented here. 12 | \arguments{ 13 | \item{n}{Integer specifying the dimensions of the matrix.} 14 | \item{val}{The constant number to put on the diagonal. 1 leads to an identity matrix} 15 | \item{type}{The type of matrix to return} 16 | } 17 | 18 | \value{ 19 | Returns and n x n matrix with zeros on the of diagonals. 20 | } 21 | 22 | \author{ 23 | Nathan Morris 24 | } 25 | 26 | \seealso{ 27 | \code{\link{as.gmatrix}} and \code{\link{as.numeric}} 28 | } 29 | \examples{ 30 | ga = gident(40) 31 | da = diag(40) 32 | sum(h(ga) == da) 33 | } 34 | 35 | \keyword{transfer} 36 | -------------------------------------------------------------------------------- /man/rsample.Rd: -------------------------------------------------------------------------------- 1 | \name{rsample} 2 | \alias{rsample} 3 | \title{ 4 | Sample and integer for each row of a gmatrix object. 5 | } 6 | \description{ 7 | Sample an integer with the unormalized (log) probabilities specified for each row. 8 | } 9 | \usage{ 10 | rsample(P, log=TRUE) 11 | } 12 | 13 | \arguments{ 14 | \item{P}{ 15 | A matrix conaining unormalizes (log) probabilities in each row. 16 | } 17 | \item{log}{ 18 | Specifies if the input is on a log scale. 19 | } 20 | } 21 | \details{ 22 | Conceptually, each row is first normalized to sum to one, and then an integer is sampled for each row under the specified probablility. 23 | } 24 | \value{ 25 | Returns a gvector with an integer value for each row. 26 | } 27 | 28 | \author{ 29 | Nathan Morris 30 | } 31 | 32 | \seealso{ 33 | \code{\link{gRowLogSums}} 34 | } 35 | 36 | 37 | 38 | 39 | -------------------------------------------------------------------------------- /man/gnamestrip.Rd: -------------------------------------------------------------------------------- 1 | \name{gnamestrip} 2 | \alias{gnamestrip} 3 | \title{ 4 | Strip a GPU object of it names, or row/colnames. 5 | } 6 | \description{ 7 | Returns a GPU object without any names or row/colnames. This may speed up certian operations. 8 | } 9 | \usage{ 10 | gnamestrip(x, dup = TRUE) 11 | } 12 | \arguments{ 13 | \item{x}{ 14 | input object to be stripped of names 15 | } 16 | \item{dup}{ 17 | if FALSE then don't duplicate \code{x} on the GPU. Return object will point to the same GPU memory as the original object. 18 | } 19 | } 20 | 21 | \value{ 22 | Returns the original object with no names. 23 | } 24 | \author{ 25 | Nathan Morris 26 | } 27 | 28 | \seealso{ 29 | \code{\link{names}}, \code{\link{colnames}} and \code{\link{dimnames}} 30 | } 31 | \examples{ 32 | x=gseq(1,2) 33 | names(x)=c("bill","joe") 34 | gnamestrip(x) 35 | 36 | } 37 | \keyword{names} 38 | 39 | -------------------------------------------------------------------------------- /man/device-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{device} 2 | \docType{methods} 3 | \alias{device} 4 | \alias{device<-} 5 | \alias{device-methods} 6 | \alias{device,gmatrix-method} 7 | \alias{device,gvector-method} 8 | \alias{device<--methods} 9 | \alias{device<-,gmatrix-method} 10 | \alias{device<-,gvector-method} 11 | \title{Get and set methods for the device slot of a gvector or gmatrix object} 12 | \description{ 13 | The \code{device} methods can be used to find what GPU device an object is stored on. 14 | The \code{device<-} can be used to move the object to a different GPU. Note that this is 15 | currently implemented by moving the object to host memory first. 16 | } 17 | \section{Methods}{ 18 | \describe{ 19 | \item{\code{signature(x = "gmatrix")}}{} 20 | \item{\code{signature(x = "gvector")}}{} 21 | }} 22 | 23 | \seealso{ 24 | \code{\link{gdup}} and \code{\link{setDevice}} 25 | } 26 | \keyword{methods} 27 | 28 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: gmatrix 2 | Type: Package 3 | Title: GPU Computing in R 4 | Version: 0.3 5 | Date: 2015-11-23 6 | Author: Nathan Morris 7 | Maintainer: Nathan Morris 8 | Description: A general framework for utilizing R to harness the power of NVIDIA GPU's. The "gmatrix" and "gvector" classes allow for easy management of the separate device and host memory spaces. Numerous numerical operations are implemented for these objects on the GPU. These operations include matrix multiplication, addition, subtraction, the kronecker product, the outer product, comparison operators, logical operators, trigonometric functions, indexing, sorting, random number generation and many more. 9 | License: GPL-3 | file LICENSE 10 | SystemRequirements: Nvidia's CUDA toolkit (>= release 5.0) and Nvidia GPU with compute capibility >=2.0 11 | OS_type: unix 12 | URL: https://github.com/njm18/gmatrix 13 | Depends: methods, stats -------------------------------------------------------------------------------- /man/gRowLogSums.Rd: -------------------------------------------------------------------------------- 1 | \name{gRowLogSums} 2 | \alias{gRowLogSums} 3 | \title{ 4 | Sum the up the rows in log space. 5 | } 6 | \description{ 7 | Sum up the rows in log space. 8 | } 9 | \usage{ 10 | gRowLogSums(x, startCol=1, endCol=ncol(x)) 11 | } 12 | 13 | \arguments{ 14 | \item{x}{ 15 | A matrix } 16 | \item{startCol}{ May be used to perform the log sum on only selected columns} 17 | \item{endCol}{ May be used to perform the log sum on only selected columns} 18 | } 19 | \details{ 20 | Calculates for each row vector \code{v} the value \code{log(sum(exp(v)))} in a way that avoids overflow. This function may be useful for mixture models. This function is only efficient for a large number of rows and a smaller number of columns. 21 | } 22 | \value{ 23 | Returns a vector with a value for each row. 24 | } 25 | 26 | \author{ 27 | Nathan Morris 28 | } 29 | 30 | \seealso{ 31 | \code{\link{\%lgspadd\%-methods}} 32 | } 33 | 34 | 35 | 36 | 37 | -------------------------------------------------------------------------------- /man/colnames-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{colnames} 2 | \docType{methods} 3 | \alias{colnames-methods} 4 | \alias{colnames,ANY-method} 5 | \alias{colnames,gmatrix-method} 6 | \alias{colnames<--methods} 7 | \alias{colnames<-,ANY-method} 8 | \alias{colnames<-,gmatrix-method} 9 | 10 | \alias{rownames-methods} 11 | \alias{rownames,ANY-method} 12 | \alias{rownames,gmatrix-method} 13 | \alias{rownames<--methods} 14 | \alias{rownames<-,ANY-method} 15 | \alias{rownames<-,gmatrix-method} 16 | 17 | \title{Methods to get and set the 'rownames' and 'colnames' of a matrix.} 18 | \description{ 19 | This documents the functions \code{rownames} and \code{colnames} for objects of class \code{gmatrix}. These methods are very similar to those defined in R base (see \code{\link{rownames}} in R base). 20 | } 21 | \section{Methods}{ 22 | 23 | \describe{ 24 | \item{\code{signature(x = "ANY")}}{} 25 | \item{\code{signature(x = "gmatrix")}}{} 26 | }} 27 | \keyword{methods} 28 | 29 | -------------------------------------------------------------------------------- /man/gset.seed.Rd: -------------------------------------------------------------------------------- 1 | \name{gset.seed} 2 | \alias{gset.seed} 3 | \title{ 4 | Set the seed values, and number of states for the GPU. 5 | } 6 | \description{ 7 | This function enables the user to set a seed value for reproducible random number generation. It also allows the user to set the number of states to tune the efficiency of random number generator for the GPU. 8 | } 9 | \usage{ 10 | gset.seed(seed=unclass(Sys.time()), total_states=as.integer(32*14*16), silent=TRUE) 11 | } 12 | 13 | \arguments{ 14 | \item{seed}{ 15 | Must be a positive integer. 16 | } 17 | \item{total_states}{ 18 | Random numbers are generated from separate streams in parallel with each stream having a current state. This variable must be a positive integer. It is recommended that the integer be a multiple of 32. If the number of states are two small or two large the GPU efficiency may be poor. 19 | } 20 | \item{silent}{ 21 | Don't print any messages besides errors. 22 | } 23 | } 24 | 25 | \author{ 26 | Nathan Morris 27 | } 28 | 29 | 30 | 31 | -------------------------------------------------------------------------------- /man/gmatTimesDiagVec.Rd: -------------------------------------------------------------------------------- 1 | \name{gmatTimesDiagVec} 2 | \alias{gmatTimesDiagVec} 3 | \title{ 4 | Multiply a matrix times the 'diag' of a vector quickly. 5 | } 6 | \description{ 7 | This function calculates \code{A \%*\% diag(v)}. It is much faster than the direct calculation as it avoids the huge matrix multiplication problem. 8 | } 9 | \usage{ 10 | gmatTimesDiagVec(A, v) 11 | } 12 | %- maybe also 'usage' for other objects documented here. 13 | \arguments{ 14 | \item{A}{ 15 | An object of class \code{gmatrix} or 'matrix'. 16 | } 17 | \item{v}{ 18 | An object of class 'gvecotr' or a 'vector'. 19 | } 20 | } 21 | 22 | \value{ 23 | Returns a \code{gmatrix} 24 | } 25 | 26 | \author{ 27 | Nathan Morris 28 | } 29 | \note{ 30 | Note that to calculate the \code{diag(v) \%*\% A} one may use the efficient formula \code{v*A}. 31 | } 32 | 33 | 34 | \seealso{ 35 | \code{\link{diag}} 36 | } 37 | \examples{ 38 | v=grnorm(10) 39 | A=gmatrix(grnorm(100),10,10,dup=FALSE) 40 | gmatTimesDiagVec(A, v) 41 | } 42 | \keyword{multiplication } 43 | 44 | -------------------------------------------------------------------------------- /man/setTuningPameters.Rd: -------------------------------------------------------------------------------- 1 | \name{setTuningPameters} 2 | \alias{setTuningPameters} 3 | \title{ 4 | Set tuning parameters 5 | } 6 | \description{ 7 | This function tunes the kernal calls to a specific GPU if the user is working with CUDA versions older than 6.5. At this point, these parameters are not well documented and should only be changed by users who can read the source code. 8 | } 9 | \usage{ 10 | setTuningPameters(force = TRUE, threads_per_block = as.integer(2^8), 11 | total_states = as.integer(32 * 14 * 16), state = 12 | unclass(Sys.time())) 13 | } 14 | %- maybe also 'usage' for other objects documented here. 15 | \arguments{ 16 | \item{force}{ 17 | logical - force the change even if the parameters have been previously set. 18 | } 19 | \item{threads_per_block}{ 20 | number of threads per block 21 | } 22 | \item{total_states}{ 23 | total states for random number generations 24 | } 25 | \item{state}{ 26 | starting state for random number generation 27 | } 28 | } 29 | 30 | \author{ 31 | Nathan Morris 32 | } 33 | 34 | -------------------------------------------------------------------------------- /man/lpgr-class.Rd: -------------------------------------------------------------------------------- 1 | \name{lpgr-class} 2 | \Rdversion{1.1} 3 | \docType{class} 4 | \alias{lpgr-class} 5 | 6 | \title{Class \code{"lpgr"}} 7 | \description{ 8 | Objects of this class must be returned by any " \code{lprf}" function which is used by the \code{gBasicHMC()} function. 9 | } 10 | \section{Objects from the Class}{ 11 | Objects can be created by calls of the form \code{new("lpgr", ...)}. 12 | } 13 | \section{Slots}{ 14 | \describe{ 15 | \item{\code{gr}:}{Object of class \code{"list"}. Must contain a list of matrices representing the first derivative of the log probility of a distribution with respect to the random variables. Each column of the matrices is for a different parrallel run. All matrices may be either on the gpu or cpu} 16 | \item{\code{lp}:}{Object of class \code{"numeric"}. Represent the log probability (without the normalizing constan) of a distribution. MUST be on the CPU.} 17 | } 18 | } 19 | \section{Methods}{ 20 | No methods defined with class "lpgr" in the signature. 21 | } 22 | \seealso{ 23 | \code{\link{gBasicHMC}} 24 | } 25 | \author{ 26 | Nathan Morris 27 | } 28 | -------------------------------------------------------------------------------- /man/colMeans-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{colMeans} 2 | \docType{methods} 3 | \alias{colMeans-methods} 4 | \alias{colMeans,ANY-method} 5 | \alias{colMeans,gmatrix-method} 6 | 7 | \alias{colSums-methods} 8 | \alias{colSums,ANY-method} 9 | \alias{colSums,gmatrix-method} 10 | 11 | \alias{rowMeans-methods} 12 | \alias{rowMeans,ANY-method} 13 | \alias{rowMeans,gmatrix-method} 14 | 15 | \alias{rowSums-methods} 16 | \alias{rowSums,ANY-method} 17 | \alias{rowSums,gmatrix-method} 18 | 19 | \title{Methods to Form Row and Column Sums and Means} 20 | \description{ 21 | This documents the \code{colMeans}, \code{rowMeans}, \code{colSums} and \code{rowSums} methods for objects of class \code{gmatrix}. 22 | These functions form row and column sums and means for an object of class \code{gmatrix}. This is implement very 23 | similarly to the base package (see \code{\link{rowSums}}, but the \code{na.rm} and \code{dims} arguments are not implemented). 24 | } 25 | \section{Methods}{ 26 | \describe{ 27 | \item{\code{signature(x = "ANY")}}{} 28 | \item{\code{signature(x = "gmatrix")}}{} 29 | }} 30 | \keyword{methods} 31 | 32 | -------------------------------------------------------------------------------- /man/gkroneckerProd.Rd: -------------------------------------------------------------------------------- 1 | \name{gkroneckerProd} 2 | \alias{gkroneckerProd} 3 | \alias{\%x\%-methods} 4 | \alias{\%x\%,ANY,ANY-method} 5 | \alias{\%x\%,gmatrix,gmatrix-method} 6 | \alias{\%x\%,gmatrix,gvector-method} 7 | \alias{\%x\%,gmatrix,numeric-method} 8 | \alias{\%x\%,gvector,gmatrix-method} 9 | \alias{\%x\%,gvector,gvector-method} 10 | \alias{\%x\%,gvector,numeric-method} 11 | \alias{\%x\%,numeric,gmatrix-method} 12 | \alias{\%x\%,numeric,gvector-method} 13 | \alias{\%x\%,gmatrix,matrix-method} 14 | \alias{\%x\%,gvector,matrix-method} 15 | \alias{\%x\%,matrix,gmatrix-method} 16 | \alias{\%x\%,matrix,gvector-method} 17 | 18 | 19 | 20 | 21 | 22 | \title{ 23 | Kronecker Product 24 | } 25 | \description{ 26 | Calculates the kronecker product of two matrices. 27 | } 28 | \usage{ 29 | gkroneckerProd(A, B) 30 | A %x% B 31 | } 32 | 33 | \arguments{ 34 | \item{A}{A \code{gmatrix}, \code{gvector}, \code{matrix} or \code{vector}} 35 | \item{B}{A \code{gmatrix}, \code{gvector}, \code{matrix} or \code{vector}} 36 | } 37 | \value{ 38 | A GPU object storing the Kronecker product. 39 | } 40 | \author{ 41 | Nathan Morris 42 | } 43 | -------------------------------------------------------------------------------- /man/gseq.Rd: -------------------------------------------------------------------------------- 1 | \name{gseq} 2 | \alias{gseq} 3 | \alias{\%to\%} 4 | \alias{\%to\%,numeric,numeric-method} 5 | \title{ 6 | Sequence 7 | } 8 | \description{ 9 | Create a sequence on the GPU. 10 | } 11 | \usage{ 12 | gseq(from = 1, to = 1, by = ((to - from)/(length.out - 1)), 13 | length.out = NULL, along.with = NULL, type = NULL) 14 | } 15 | 16 | \arguments{ 17 | \item{from, to}{ 18 | the starting and (maximal) end value of the sequence. 19 | } 20 | 21 | \item{by}{ 22 | number: increment of the sequence. 23 | } 24 | \item{length.out}{ 25 | desired length of the sequence. A non-negative number, which for seq and seq.int will be rounded up if fractional. 26 | } 27 | \item{along.with}{ 28 | take the length from the length of this argument 29 | } 30 | \item{type}{ 31 | output type (i.e. \code{"double"}, \code{"single"}, \code{"integer"} or \code{"logical"}) 32 | } 33 | } 34 | 35 | \value{ 36 | returns a \code{gvector} with the specified sequence. In addition the operator \code{\%to\%} mimics the R base oporator \code{:}. 37 | } 38 | 39 | \author{ 40 | Nathan Morris 41 | } 42 | 43 | \seealso{ 44 | \code{\link{seq}} 45 | } 46 | \examples{ 47 | gseq(1,100) 48 | 1\%to\%10 49 | } 50 | -------------------------------------------------------------------------------- /man/beta.Rd: -------------------------------------------------------------------------------- 1 | \name{gdbeta} 2 | \alias{gdbeta} 3 | \alias{grbeta} 4 | 5 | \title{ 6 | The Beta Distribution 7 | } 8 | \description{ 9 | Density and random generation for the Beta distribution with parameters \code{shape1} and \code{shape2}. 10 | } 11 | \usage{ 12 | gdbeta(x, shape1, shape2, ncp = 0, log = FALSE, type = "d") 13 | grbeta(n, shape1, shape2, ncp = 0, type = "d") 14 | } 15 | %- maybe also 'usage' for other objects documented here. 16 | \arguments{ 17 | \item{x}{vector of quantiles} 18 | \item{n}{number of random values to return} 19 | \item{shape1, shape2}{positive parameters of the Beta distribution} 20 | \item{ncp}{must be 0 at this point} 21 | \item{log}{logical; if TRUE, probabilities p are given as log(p)} 22 | \item{type}{specify the type; may be \code{"double"}, \code{"single"} (or short form \code{"d"} or \code{"s"}) } 23 | } 24 | \details{ 25 | Very similar to the R stats functionality. 26 | } 27 | \value{ 28 | \code{gdbeta} gives the density and \code{grbeta} generates random deviates. 29 | } 30 | 31 | \author{ 32 | Nathan Morris 33 | } 34 | \seealso{ 35 | \code{\link{dbeta}} 36 | } 37 | \examples{ 38 | myRndNums = grbeta(10,c(1,2), c(1,2,3,4,5)) 39 | } 40 | 41 | \keyword{beta} 42 | 43 | -------------------------------------------------------------------------------- /man/type.Rd: -------------------------------------------------------------------------------- 1 | \name{type} 2 | \alias{type} 3 | \alias{type<-} 4 | \alias{type<--methods} 5 | \alias{type<-,gmatrix-method} 6 | \alias{type<-,gvector-method} 7 | \alias{type-methods} 8 | \alias{type,gmatrix-method} 9 | \alias{type,gvector-method} 10 | \title{ 11 | Get or set the type of a GPU object 12 | } 13 | \description{ 14 | These functions may be used to get or set the type of a GPU object. May be used as 15 | type(x) 16 | type(x)<-value 17 | } 18 | 19 | \arguments{ 20 | \item{x}{A GPU object of class \code{gvector} or \code{gmatrix}} 21 | \item{value}{The type to convert the object to. There are three different ways to specify this. One may use the \code{"double"}, \code{"single"}, \code{"integer"} or \code{"logical"} notation. Alternatively the short form \code{"d"}, \code{"s"}, \code{"i"} or \code{"s"} notation may be used. Finally the internal integer representation of 0L, 1L, 2L or 3L may be used.} 22 | } 23 | 24 | \value{ 25 | type(x) returns the type of x 26 | type(x)<-value change the type of x 27 | } 28 | 29 | \author{ 30 | Nathan Morris 31 | } 32 | 33 | \seealso{ 34 | \code{\link{convertType}} 35 | } 36 | \examples{ 37 | x=g(1:4) 38 | type(x)="d" #change the type from "integer" to "double" 39 | } 40 | \keyword{type } 41 | 42 | -------------------------------------------------------------------------------- /man/poisson.Rd: -------------------------------------------------------------------------------- 1 | \name{gdpois} 2 | \alias{gdpois} 3 | \alias{grpois} 4 | \title{ 5 | The Poisson Distribution 6 | } 7 | \description{ 8 | Density and random generation for the Poisson distribution with parameter lambda. 9 | } 10 | \usage{ 11 | gdpois(x, lambda, log = FALSE, type = "d") 12 | grpois(n, lambda) 13 | } 14 | \arguments{ 15 | \item{x}{ 16 | vector of (non-negative integer) quantiles 17 | } 18 | \item{n}{ 19 | number of random values to return 20 | } 21 | \item{lambda}{ 22 | vector of (non-negative) means 23 | } 24 | \item{log}{ 25 | logical; if TRUE, probabilities p are given as log(p) 26 | } 27 | 28 | \item{type}{specify the type; may be \code{"double"}, \code{"single"} (or short form \code{"d"} or \code{"s"}) } 29 | } 30 | \details{ 31 | Very similar to the R stats functionality. 32 | } 33 | \value{ 34 | \code{gdpois} gives the (log) density, and \code{grpois} generates random deviates. 35 | } 36 | 37 | \author{ 38 | Nathan Morris 39 | } 40 | \note{ 41 | The algorithm for simulating from the poisson distribution was modified from the GSL library which uses the Knuth method. 42 | } 43 | 44 | \seealso{ 45 | \code{\link{dpois}} 46 | } 47 | \examples{ 48 | myRndNums = grpois(10,4) 49 | } 50 | 51 | \keyword{poisson } 52 | 53 | -------------------------------------------------------------------------------- /man/binomial.Rd: -------------------------------------------------------------------------------- 1 | \name{gdbinom} 2 | \alias{gdbinom} 3 | \alias{grbinom} 4 | \title{The Binomial Distribution} 5 | \description{ 6 | Density and random generation for the binomial distribution with parameters \code{size} and \code{prob}. 7 | } 8 | \usage{ 9 | gdbinom(x, size, prob, log = FALSE, type = "d") 10 | grbinom(n, size, prob) 11 | } 12 | 13 | \arguments{ 14 | \item{x}{vector of quantiles.} 15 | \item{n}{number of observations} 16 | \item{size}{number of trials (zero or more)} 17 | \item{prob}{probability of success on each trial} 18 | \item{log}{logical; if TRUE, probabilities p are given as log(p).} 19 | \item{type}{specify the type; may be \code{"double"}, \code{"single"} (or short form \code{"d"} or \code{"s"}) } 20 | } 21 | \details{ 22 | Very similar to the R stats functionality. 23 | } 24 | \value{ 25 | \code{gdbinom} gives the density and \code{grbinom} generates random deviates 26 | } 27 | 28 | \author{ 29 | Nathan Morris 30 | } 31 | \note{ 32 | The algorythm for simulating from the poisson distribution was modified from the GSL library which uses the modified from the GSL library which uses the Knuth method. 33 | } 34 | 35 | \seealso{ 36 | \code{\link{dbinom}} 37 | } 38 | \examples{ 39 | myRndNums = grbinom(10,10,.6) 40 | } 41 | \keyword{binomial} 42 | 43 | -------------------------------------------------------------------------------- /man/gorder.Rd: -------------------------------------------------------------------------------- 1 | \name{gorder} 2 | \alias{gorder} 3 | \title{ 4 | Ordering Permutation 5 | } 6 | \description{ 7 | \code{gorder} returns a permutation which rearranges its first argument into ascending or descending order. 8 | } 9 | \usage{ 10 | gorder(x, decreasing = FALSE, stable = TRUE, sortx=FALSE) 11 | } 12 | %- maybe also 'usage' for other objects documented here. 13 | \arguments{ 14 | \item{x}{ 15 | object to be ordered 16 | } 17 | \item{decreasing}{ 18 | logical to specify sort order 19 | } 20 | \item{stable}{ 21 | make sure that ties are in the original order 22 | } 23 | \item{sortx}{ 24 | if \code{sortx=TRUE}, then x will be modified by sorting it. This avoids an extra duplication of the \code{x}. 25 | By leaving \code{sortx=FALSE}, an extra duplication of \code{x} is performed to avoid changing the input value. 26 | } 27 | } 28 | \details{ 29 | Unlike the base R function, only one input column may be given. The thrust library is used for this operation. 30 | } 31 | \value{ 32 | a \code{gvector} of type \code{"integer"} which will permute the input vector to the proper sort order. 33 | } 34 | 35 | \author{ 36 | Nathan Morris 37 | } 38 | \seealso{ 39 | \code{\link{order}} 40 | } 41 | \examples{ 42 | x=grnorm(10) 43 | i=gorder(x) 44 | x[i] #sort x 45 | } 46 | 47 | 48 | -------------------------------------------------------------------------------- /man/gmm.Rd: -------------------------------------------------------------------------------- 1 | \name{gmm} 2 | \alias{gmm} 3 | \title{ 4 | Multiply two matrices with the output matrix allready allocated. 5 | } 6 | \description{ 7 | In effect this function sets C <- A \%*\% B. This makes it possible to avoid repeated allocation and deallocation steps which are very computationaly costly. 8 | } 9 | \usage{ 10 | gmm(A, B, C, trA=FALSE, trB=FALSE, accum=FALSE) 11 | } 12 | 13 | \arguments{ 14 | \item{A, B}{ 15 | Matrices to multiply together. 16 | } 17 | \item{C}{ 18 | Matrices where output will be saved. 19 | } 20 | \item{trA, trB}{ 21 | Should A or B be transposed. 22 | } 23 | \item{accum}{ 24 | if accum is set to TRUE, the multiplied matrix will be added to C (i.e. C<-C+A \%*\% B). 25 | } 26 | 27 | 28 | } 29 | \details{ 30 | This function takes advantage of the fact that gmatrix objects are stored as pointers making it posible modify the input to a function. Thus the area of memory on the GPU pointed to by the C object is modified to contain A \%*\% B. 31 | } 32 | \value{ 33 | Returns C invisibly. 34 | } 35 | 36 | \author{ 37 | Nathan Morris 38 | } 39 | 40 | 41 | \examples{ 42 | A=gmatrix(rnorm(10), 2, 5) 43 | B=gmatrix(rnorm(10), 5, 2) 44 | C=gmatrix(0,2,2) 45 | gmm(A,B,C) 46 | gmm(B,A,C,TRUE,TRUE) 47 | 48 | } 49 | \keyword{multiplication} 50 | 51 | -------------------------------------------------------------------------------- /man/uniform.Rd: -------------------------------------------------------------------------------- 1 | \name{grunif} 2 | \alias{grunif} 3 | \alias{gdunif} 4 | \title{ 5 | The Uniform Distribution 6 | } 7 | \description{ 8 | These functions provide information about the uniform distribution on the interval from \code{min} to \code{max}. dunif gives the density and runif generates random deviates. 9 | } 10 | \usage{ 11 | gdunif(x, min = 0, max = 1, log = FALSE, type = "d") 12 | grunif(n, min = 0, max = 1, type = "d") 13 | 14 | } 15 | %- maybe also 'usage' for other objects documented here. 16 | \arguments{ 17 | \item{x}{vector of quantiles.} 18 | \item{n}{number of observations} 19 | \item{min, max}{lower and upper limits of the distribution} 20 | \item{log}{logical; if TRUE, probabilities/densities p are returned as log(p)} 21 | \item{type}{specify the type; may be \code{"double"}, \code{"single"} (or short form \code{"d"} or \code{"s"}) } 22 | } 23 | \details{ 24 | If min or max are not specified they assume the default values of 0 and 1 respectively. Works very similarly to the R stats functions. 25 | } 26 | 27 | \author{ 28 | Nathan Morris 29 | } 30 | \note{ 31 | Random number generation implemented with the cuRAND library. 32 | } 33 | 34 | \seealso{ 35 | \code{\link{runif}} 36 | } 37 | \examples{ 38 | myRndNums = grunif(10) 39 | 40 | } 41 | \keyword{ uniform } 42 | 43 | -------------------------------------------------------------------------------- /man/convertType.Rd: -------------------------------------------------------------------------------- 1 | \name{convertType} 2 | \alias{convertType} 3 | 4 | \title{Convert the type of a GPU object} 5 | \description{ 6 | This function is used to convert the type (i.e. \code{"double"}, \code{"single"}, \code{"integer"} or \code{"logical"}) of a \code{gmatrix} or \code{gvector} object. 7 | } 8 | \usage{ 9 | convertType(x, to, dup = TRUE) 10 | } 11 | 12 | \arguments{ 13 | \item{x}{A GPU object of class \code{gvector} or \code{gmatrix}} 14 | \item{to}{The type to convert the object to. There are three different ways to specify this. One may use the \code{"double"}, \code{"single"}, \code{"integer"} or \code{"logical"} notation. Alternatively the short form \code{"d"}, \code{"s"}, \code{"i"} or \code{"s"} notation may be used. Finally the internal integer representation of 0L, 1L, 2L or 3L may be used.} 15 | \item{dup}{This may be set to 'FALSE' to avoid duplicating \code{x} in the event the original type and the \code{to} type are the same} 16 | } 17 | %\details{ 18 | %% ~~ If necessary, more details than the description above ~~ 19 | %} 20 | \value{ 21 | Returns the x after converting it to a new type. 22 | } 23 | 24 | \author{ 25 | Nathan Morris 26 | } 27 | 28 | \seealso{ 29 | \code{\link{type}} 30 | } 31 | \examples{ 32 | 33 | x=gseq(1,10) 34 | y=convertType(x,'d') 35 | type(y) 36 | 37 | } 38 | \keyword{ type } 39 | 40 | -------------------------------------------------------------------------------- /man/gdup.Rd: -------------------------------------------------------------------------------- 1 | \name{gdup} 2 | \alias{gdup} 3 | \title{ 4 | Duplicate a GPU object 5 | } 6 | \description{ 7 | This function duplicates a \code{gmatrix} or \code{gvector} object on the specified device. 8 | } 9 | \usage{ 10 | gdup(x, dev=getDevice()) 11 | } 12 | 13 | \arguments{ 14 | \item{x}{ 15 | object to duplicate 16 | } 17 | \item{dev}{ 18 | device to duplicate the object on 19 | } 20 | } 21 | \details{ 22 | This function is very important because the \code{gmatrix} and \code{gvector} classes store only a pointer to an object on the GPU device. Thus, a line such as \code{y<-x} will duplicate the pointer but not the actual data on the GPU. One should use instead \code{y<-gdup(x)}. The \code{gdup} function is also useful for copying the data to a different GPU device. 23 | } 24 | \value{ 25 | a \code{gmatrix} or \code{gvector} object. 26 | } 27 | 28 | \author{ 29 | Nathan Morris 30 | } 31 | 32 | \seealso{ 33 | To move data to a different device instead of copying it see \code{\link{device}} 34 | } 35 | \examples{ 36 | 37 | #problematic code 38 | x=gseq(1,10) 39 | y=x 40 | x[1]=1000 41 | show(y)#changes to x also change y 42 | 43 | #correct 44 | x=gseq(1,10) 45 | y=gdup(x) 46 | x[1]=1000 47 | show(y) #changes to x do not change y 48 | 49 | #copy to a different device 50 | #y=gdup(x, dev=2L) 51 | } 52 | \keyword{copy } 53 | 54 | -------------------------------------------------------------------------------- /man/as.numeric-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{as.numeric, as.integer, as.logical, as.vector and as.matrix} 2 | \docType{methods} 3 | \alias{as.numeric-methods} 4 | \alias{as.numeric,gmatrix-method} 5 | \alias{as.numeric,gvector-method} 6 | \alias{as.integer-methods} 7 | \alias{as.integer,gmatrix-method} 8 | \alias{as.integer,gvector-method} 9 | \alias{as.logical-methods} 10 | \alias{as.logical,gmatrix-method} 11 | \alias{as.logical,gvector-method} 12 | \alias{as.matrix.gmatrix} 13 | \alias{as.matrix.gvector} 14 | \alias{as.matrix-methods} 15 | \alias{as.matrix,ANY-method} 16 | \alias{as.matrix,gmatrix-method} 17 | \alias{as.matrix,gvector-method} 18 | \alias{as.vector.gmatrix} 19 | \alias{as.vector.gvector} 20 | \alias{as.vector-methods} 21 | \alias{as.vector,ANY-method} 22 | \alias{as.vector,gmatrix-method} 23 | \alias{as.vector,gvector-method} 24 | \alias{as.vector.gmatrix} 25 | \alias{as.vector.gvector} 26 | 27 | \title{Methods to coerce a GPU object to an R object} 28 | \description{ 29 | The functions \code{as.numeric}, \code{as.integer}, \code{as.matrix} and \code{as.vector} are intended to bring a GPU object to the main 30 | host memory and coerce it into the given type. 31 | } 32 | \section{Methods}{ 33 | \describe{ 34 | \item{\code{signature(x = "gmatrix")}}{} 35 | \item{\code{signature(x = "gvector")}}{} 36 | }} 37 | \keyword{methods} 38 | \seealso{ 39 | \code{\link{h}} 40 | } 41 | -------------------------------------------------------------------------------- /man/g.rep.Rd: -------------------------------------------------------------------------------- 1 | \name{g.rep} 2 | \alias{g.rep} 3 | \title{ 4 | Replicate Elements of a vector or gvector, 5 | } 6 | \description{ 7 | \code{g.rep} replicates the 'vector' or \code{gvector}. 8 | } 9 | \usage{ 10 | g.rep(x, times = 1L, each = 1L, type = NULL) 11 | } 12 | %- maybe also 'usage' for other objects documented here. 13 | \arguments{ 14 | \item{x}{ 15 | a 'vector' or 'gvector.' 16 | } 17 | \item{times}{ 18 | a single integer representing the number of times the object should be replicated. 19 | } 20 | \item{each}{ 21 | a single integer representing the number of times each element should be replicated. If each is specified, the times will be ignored. 22 | } 23 | \item{type}{ 24 | coerce the output to the given type (i.e \code{"double"}, \code{"single"}, \code{"integer"} or \code{"logical"}). 25 | } 26 | } 27 | \details{ 28 | \code{g.rep} is somewhat simplified from the R base \code{rep} function. It is called \code{g.rep} to avoid conflict with the \code{grep} function. It can replicate in two different ways. If times is specified then the entire vector is replicated, while when each is specified each element is replicated one at a time. 29 | } 30 | \value{ 31 | a \code{gvector} object with the replicated information 32 | } 33 | 34 | \author{ 35 | Nathan Morris 36 | } 37 | 38 | \seealso{ 39 | \code{\link{rep}} 40 | } 41 | \examples{ 42 | x=g.rep(1:2, 2) #returns (1,2,1,2) 43 | x=g.rep(1:2, each=2) #returns (1,1,2,2) 44 | } 45 | \keyword{replicate} 46 | 47 | -------------------------------------------------------------------------------- /man/gamma.Rd: -------------------------------------------------------------------------------- 1 | \name{gdgamma} 2 | \alias{gdgamma} 3 | \alias{grgamma} 4 | 5 | \title{ 6 | The Gamma Distribution 7 | } 8 | \description{ 9 | Density, and random generation for the Gamma distribution with parameters shape and scale. 10 | } 11 | \usage{ 12 | gdgamma(x, shape, rate = 1, scale = 1/rate, log = FALSE, type = "d") 13 | grgamma(n, shape, rate = 1, scale = 1/rate, type = "d") 14 | } 15 | 16 | \arguments{ 17 | \item{x}{vector of quantiles} 18 | \item{n}{number of random values to return} 19 | \item{shape,scale}{shape and scale parameters. Must be positive, \code{scale} strictly} 20 | \item{rate}{an alternative way to specify the scale} 21 | \item{log}{logical; if TRUE, probabilities/densities p are returned as log(p)} 22 | \item{type}{specify the type; may be \code{"double"}, \code{"single"} (or short form \code{"d"} or \code{"s"}) } 23 | } 24 | \details{ 25 | Works in much the same way as the R base functions. 26 | } 27 | \value{ 28 | \code{gdgamma} gives the density and \code{grgamma} generates random deviates. 29 | } 30 | \references{ 31 | Random gamma simulation was implemented using the algorithm described in: 32 | Marsaglia and Tsang (2000) A Simple Method for Generating Gamma Variables. ACM Transactions on Mathematical Software. Volume 26 Issue 3, Pages 363-372. 33 | } 34 | \author{ 35 | Nathan Morris 36 | } 37 | \seealso{ 38 | \code{\link{dgamma}} 39 | } 40 | \examples{ 41 | myRndNums = grgamma(10, c(1,2)) 42 | } 43 | 44 | \keyword{gamma} 45 | 46 | -------------------------------------------------------------------------------- /man/gsvd-class.Rd: -------------------------------------------------------------------------------- 1 | \name{gsvd-class} 2 | \Rdversion{1.1} 3 | \docType{class} 4 | \alias{svd} 5 | \alias{gsvd-class} 6 | \alias{svd-methods} 7 | \alias{svd,ANY-method} 8 | \alias{svd,gmatrix-method} 9 | 10 | 11 | \title{Class \code{"gsvd"}} 12 | \description{ 13 | Contains the results of an SVD decomposition as returned by the svd method. The SVD method is only available for cuda v7.0 or greater. 14 | } 15 | \section{Objects from the Class}{ 16 | Objects should be created by a call to the \code{svd()} method on a \code{gmatrix} object. The slots of this object are essentually the same as those created by the base \code{svd} function. However the \code{VT} is the transpose of the \code{v} slot in R base. The \code{gmatrix} \code{svd} function does not allow the user to select the number of singular values. 17 | } 18 | \section{Slots}{ 19 | \describe{ 20 | \item{\code{U}:}{Object of class \code{"gmatrix"} whose columns contain the left singular vectors. } 21 | \item{\code{S}:}{Object of class \code{"gvector"} containing the singular values.} 22 | \item{\code{VT}:}{Object of class \code{"gmatrix"} whose columns contain the TRANSPOSE of the left singular vectors.} 23 | } 24 | } 25 | 26 | 27 | \author{ 28 | Nathan Morris 29 | } 30 | 31 | %% ~Make other sections like Warning with \section{Warning }{....} ~ 32 | 33 | \seealso{ 34 | \code{\link{svd}} 35 | } 36 | \examples{ 37 | M=gmatrix(grnorm(25), 5,5,dup=FALSE) 38 | mysvd=svd(M) 39 | mysvd@U %*% diag(S) %*% mysvd@VT #reconstruct the matrix M 40 | } 41 | \keyword{classes} 42 | -------------------------------------------------------------------------------- /man/setDevice.Rd: -------------------------------------------------------------------------------- 1 | \name{setDevice} 2 | \alias{setDevice} 3 | \alias{getDevice} 4 | \alias{listDevices} 5 | \title{ 6 | Get and set the current device. 7 | } 8 | \description{ 9 | On systems with multiple GPUs the current device may be set or investigated with these functions. 10 | } 11 | \usage{ 12 | setDevice(device,force=FALSE,silent=FALSE,...) 13 | getDevice() 14 | listDevices() 15 | } 16 | %- maybe also 'usage' for other objects documented here. 17 | \arguments{ 18 | \item{device}{ 19 | Device number to set the device to 20 | } 21 | \item{force}{ 22 | Force reset of the tuning parameters even if they have already been set 23 | } 24 | \item{silent}{ 25 | Prints a message if TRUE 26 | } 27 | \item{\dots}{ 28 | Arguments to set the tuning parameters. It's not a good idea to mess with these at this point. 29 | } 30 | } 31 | \details{ 32 | All operations are performed on the current GPU device only. 33 | An error will be returned if the user attempts to perform an operation on a device that is not the current device. Details of the available devices can be obtained with the 'listDevices' function. 34 | } 35 | \value{ 36 | \code{setDevice} returns TRUE. \code{getDevice} returns the current device number. \code{listDevices} returns a \code{data.frame} with information about the available devices. 37 | } 38 | 39 | \author{ 40 | Nathan Morris 41 | } 42 | 43 | \seealso{ 44 | \code{\link{device}}, \code{\link{gdup}} 45 | } 46 | \examples{ 47 | listDevices() 48 | getDevice() 49 | #setDevice(1) 50 | } 51 | \keyword{device} 52 | 53 | -------------------------------------------------------------------------------- /man/gouter.Rd: -------------------------------------------------------------------------------- 1 | \name{gouter} 2 | \alias{gouter} 3 | \alias{\%o\%} 4 | \alias{\%o\%-methods} 5 | \alias{\%o\%,ANY,ANY-method} 6 | \alias{\%o\%,gvector,gvector-method} 7 | \alias{\%o\%,gvector,logical-method} 8 | \alias{\%o\%,gvector,numeric-method} 9 | \alias{\%o\%,logical,gvector-method} 10 | \alias{\%o\%,numeric,gvector-method} 11 | \title{ 12 | GPU generalized outer product. 13 | } 14 | \description{ 15 | This function calculates the outer product of two gvectors. 16 | } 17 | \usage{ 18 | gouter(x, y, FUN = "*", normalOrder = TRUE) 19 | } 20 | 21 | \arguments{ 22 | \item{x}{ 23 | a 'vector' or \code{gvector} object 24 | } 25 | \item{y}{ 26 | a 'vector' or \code{gvector} object 27 | } 28 | \item{FUN}{ 29 | one of the following characters '*', '+', '-', '/' or '^' 30 | } 31 | \item{normalOrder}{ 32 | logical input determining which order the operation should be performed in. 33 | } 34 | } 35 | \details{ 36 | This function is similar to the \code{\link{outer}} function in R base. It performs the specified operation on all posible combinations of elements from the first vector with the second. This function does not behave the same as R base when operating on matrices. Also, the operator \%o\% may be used as in the R base package. 37 | } 38 | \value{ 39 | returns a \code{gmatrix} with the specified operation performed 40 | } 41 | 42 | \author{ 43 | Nathan Morris 44 | } 45 | \seealso{ 46 | \code{\link{outer}}, \code{\link{\%o\%}} 47 | } 48 | \examples{ 49 | gouter(grnorm(10), grnorm(10), FUN="-") 50 | } 51 | 52 | \keyword{outer} 53 | 54 | -------------------------------------------------------------------------------- /man/gmatrix-internal.Rd: -------------------------------------------------------------------------------- 1 | \name{skeleton-internal} 2 | \title{Internal skeleton objects} 3 | 4 | \alias{.check_make_valid} 5 | \alias{.convert_to_appropriate_class} 6 | \alias{.exprs_AB} 7 | \alias{.exprs_Av} 8 | \alias{.exprs_compare_e1e2} 9 | \alias{.exprs_compare_str} 10 | \alias{.exprs_compare_xy} 11 | \alias{.exprs_e1e2} 12 | \alias{.exprs_gc_e1e2} 13 | \alias{.exprs_gc_e2e1} 14 | \alias{.exprs_gc12_str} 15 | \alias{.exprs_gc21_str} 16 | \alias{.exprs_gpu_cpu_xy} 17 | \alias{.exprs_l_e1e2} 18 | \alias{.exprs_l_gc_e1e2} 19 | \alias{.exprs_l_gc_e2e1} 20 | \alias{.exprs_l_gc12_str} 21 | \alias{.exprs_l_gc21_str} 22 | \alias{.exprs_l_gpu_cpu_xy} 23 | \alias{.exprs_l_str} 24 | \alias{.exprs_l_xy} 25 | \alias{.exprs_sf_e1e2} 26 | \alias{.exprs_sf_gc_e1e2} 27 | \alias{.exprs_sf_gc_e2e1} 28 | \alias{.exprs_sf_gc12_str} 29 | \alias{.exprs_sf_gc21_str} 30 | \alias{.exprs_sf_gpu_cpu_xy} 31 | \alias{.exprs_sf_str} 32 | \alias{.exprs_sf_xy} 33 | \alias{.exprs_str} 34 | \alias{.exprs_xy} 35 | \alias{.gcolon} 36 | \alias{.gpu_get} 37 | \alias{.onLoad} 38 | \alias{.onUnload} 39 | \alias{.Rclass_to_type} 40 | \alias{.Rclass_to_type_int} 41 | %\alias{.resetDevice} 42 | \alias{.seq} 43 | \alias{.silent} 44 | \alias{.type_name} 45 | \alias{.type_num} 46 | \alias{.unOps} 47 | \alias{.strOpNonExchang} 48 | \alias{.strOpExchang} 49 | \alias{.nonExOps} 50 | \alias{.exOps} 51 | \alias{.str_unaryops} 52 | 53 | 54 | \alias{initialize-methods} 55 | \alias{initialize,gmatrix-method} 56 | \alias{initialize,gvector-method} 57 | 58 | \alias{\%op\%} 59 | \alias{index-class} 60 | 61 | \description{Internal skeleton objects.} 62 | \details{These are not to be called by the user.} 63 | \keyword{internal} -------------------------------------------------------------------------------- /man/indexing-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{indexing} 2 | \docType{methods} 3 | 4 | \alias{[-methods} 5 | \alias{[,ANY,ANY,ANY-method} 6 | \alias{[,gmatrix,index,index-method} 7 | \alias{[,gmatrix,index,missing-method} 8 | \alias{[,gmatrix,missing,index-method} 9 | \alias{[,gmatrix,missing,missing-method} 10 | \alias{[,gvector,ANY,ANY-method} 11 | \alias{[,nonStructure,ANY,ANY-method} 12 | 13 | 14 | \alias{[<--methods} 15 | \alias{[<-,ANY,ANY,ANY-method} 16 | \alias{[<-,gmatrix,index,index-method} 17 | \alias{[<-,gmatrix,index,missing-method} 18 | \alias{[<-,gmatrix,missing,index-method} 19 | \alias{[<-,gmatrix,missing,missing-method} 20 | \alias{[<-,gvector,ANY,ANY-method} 21 | 22 | 23 | \title{Indexing Methods} 24 | \description{ 25 | These methods are used to perform indexing operations. They work in much the same way as the base R functions. However, if the indexes involve very random numbers, it maybe very difficult for the GPU to coalesce the memory operations. Therefore it may be faster to move the object back to the host befor the indexing operations are performed. 26 | } 27 | 28 | \section{Methods}{ 29 | \describe{ 30 | 31 | \item{\code{signature(x = "gvector", i = "ANY", j = "ANY")}}{} 32 | \item{\code{signature(x = "ANY", i = "ANY", j = "ANY")}}{} 33 | \item{\code{signature(x = "gmatrix", i = "index", j = "index")}}{} 34 | \item{\code{signature(x = "gmatrix", i = "index", j = "missing")}}{} 35 | \item{\code{signature(x = "gmatrix", i = "missing", j = "index")}}{} 36 | \item{\code{signature(x = "gmatrix", i = "missing", j = "missing")}}{} 37 | \item{\code{signature(x = "gvector", i = "ANY", j = "ANY")}}{} 38 | \item{\code{signature(x = "nonStructure", i = "ANY", j = "ANY")}}{} 39 | 40 | 41 | } 42 | } 43 | \keyword{methods} 44 | -------------------------------------------------------------------------------- /man/gqr-class.Rd: -------------------------------------------------------------------------------- 1 | \name{gqr-class} 2 | \Rdversion{1.1} 3 | \docType{class} 4 | \alias{gqr-class} 5 | 6 | 7 | \alias{solve} 8 | \alias{solve-methods} 9 | \alias{solve,ANY-method} 10 | \alias{solve,gmatrix-method} 11 | \alias{solve,gqr-method} 12 | \alias{qr-methods} 13 | \alias{qr,ANY-method} 14 | \alias{qr,gmatrix-method} 15 | \alias{gqr.coef} 16 | \alias{gqr.coef-methods} 17 | \alias{gqr.coef,ANY-method} 18 | \alias{gqr.coef,gqr-method} 19 | 20 | 21 | \title{Class \code{"gqr"}} 22 | \description{ 23 | Contains the results of a QR decomposition from using the \code{qr()} method on a \code{gmatrix} object. Note that the \code{gmatrix} \code{solve} function uses QR decompostion. Also, \code{qr.coef} can act on the \code{gqr} object. The \code{qr} method does not use pivoting or check the matrix rank. The QR and related methods are only available for cuda v7.0 or greater. 24 | } 25 | \section{Objects from the Class}{ 26 | Objects can be created by calls of the \code{qr()} method. 27 | } 28 | \section{Slots}{ 29 | \describe{ 30 | \item{\code{qr}:}{Information about the Q and R matrices stored as and bject of class \code{"gmatrix"}.} 31 | \item{\code{qraux}:}{Information about the Q matrix stored as an object of class \code{"gvector"}. } 32 | } 33 | } 34 | \section{Methods}{ 35 | \describe{ 36 | \item{qr.coef}{Simular to the \code{\link{qr.coef}} function. } 37 | \item{solve}{Simular to the \code{\link{solve.qr}} function. } 38 | } 39 | } 40 | 41 | \author{ 42 | Nathan Morris 43 | } 44 | 45 | 46 | \seealso{ 47 | \code{\link{qr}}, \code{\link{qr.coef}}, \code{\link{solve.qr}}, \code{\link{solve}} 48 | } 49 | \examples{ 50 | M=gmatrix(grnorm(25), 5,5,dup=FALSE) 51 | y=grnorm(5) 52 | solve(M) 53 | solve(M,y) 54 | myqr =qr(M) 55 | solve(myqr,y) 56 | } 57 | \keyword{classes} -------------------------------------------------------------------------------- /man/g.Rd: -------------------------------------------------------------------------------- 1 | \name{g} 2 | \alias{g} 3 | \alias{h} 4 | \title{ 5 | Transfer and R object to and from the GPU. 6 | } 7 | \description{The function \code{g} transfers the object to the GPU. 8 | The function \code{h} transfers it back to the host.} 9 | \usage{ 10 | g(x, type = NULL, dup = TRUE) 11 | h(x) 12 | } 13 | %- maybe also 'usage' for other objects documented here. 14 | \arguments{ 15 | \item{x}{The object to be transfered.} 16 | \item{type}{The type to convert the object to. There are three different ways to specify this. One may use the \code{"double"}, \code{"single"}, \code{"integer"} or \code{"logical"} notation. Alternatively the short form \code{"d"}, \code{"s"}, \code{"i"} or \code{"s"} notation may be used. Finally the internal integer representation of 0L, 1L, 2L or 3L may be used.} 17 | \item{dup}{This may be set to 'FALSE' to avoid duplicating x in the event that it is on the GPU allready and the original type is the same as the type argument.} 18 | } 19 | \details{ 20 | These functions may be more convenient than functions such as 'as.gmatrix' or 'as.gvector'. In addition to having a very short name, one does not need to consider whether the object is a vector or matrix. 21 | } 22 | \value{ 23 | The 'h' function transfers device data back to the host and returns a matrix or vector, while the 'g' function 24 | returns an object of class \code{gmatrix} or \code{gvector} storing the data on the GPU. 25 | } 26 | 27 | \author{ 28 | Nathan Morris 29 | } 30 | 31 | \seealso{ 32 | \code{\link{as.gmatrix}} and \code{\link{as.numeric}} 33 | } 34 | \examples{ 35 | h_x=1:10 36 | g_x=g(h_x) #Transfer to the device 37 | g_ans=crossprod(g_x) #Do a a calculation 38 | h_ans=h(g_ans) #Transfer back to the host 39 | } 40 | 41 | \keyword{transfer} 42 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | All of the code in this package is released under the GPL-3 license. However, several 2 | parts of the code are modified versions of code found in various places. 3 | 4 | First the HMC code is a heavily modified version of the code created by Dr. Radford Neal. 5 | The accompanying license on his website statest: 6 | #> This directory contains a preliminary version of GRIMS, released 2012-06-07. 7 | #> 8 | #> The contents of this directory are Copyright (c) 2011-2012 by Radford M. Neal. 9 | #> 10 | #> Permission is granted for anyone to copy, use, modify, or distribute these 11 | #> programs and accompanying documents for any purpose, provided this copyright 12 | #> notice is retained and prominently displayed, along with a note saying 13 | #> that the original programs are available from Radford Neal's web page, and 14 | #> note is made of any changes made to these programs. These programs and 15 | #> documents are distributed without any warranty, express or implied. As the 16 | #> programs were written for research purposes only, they have not been tested 17 | #> to the degree that would be advisable in any important application. All use 18 | #> of these programs is entirely at the user's own risk. 19 | #> 20 | #> This software can be obtained from http://www.cs.utoronto.ca/~radford/GRIMS.html 21 | 22 | Second, configure.ac file and other components of the build system borrowed heavily from 23 | the 'magma' R package by Dr. Brian Smith which is licensed under GNU GPL 3 or later. 24 | https://cran.r-project.org/src/contrib/Archive/magma/ 25 | 26 | Third the binomial distribution simulation is modified from the GSL library which is liscensed 27 | under GNU GPL-3. http://www.gnu.org/licenses/licenses.html. 28 | 29 | Neither Dr. Neal nor Dr. Smith have reviewed the changes to the code made by the gmatrix 30 | package author (Dr. Nathan Morris). -------------------------------------------------------------------------------- /man/mm-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{matrix multiplication} 2 | \docType{methods} 3 | \alias{\%*\%-methods} 4 | \alias{\%*\%,gmatrix,gmatrix-method} 5 | \alias{\%*\%,gmatrix,gvector-method} 6 | \alias{\%*\%,gmatrix,logical-method} 7 | \alias{\%*\%,gmatrix,matrix-method} 8 | \alias{\%*\%,gmatrix,numeric-method} 9 | \alias{\%*\%,gvector,gmatrix-method} 10 | \alias{\%*\%,gvector,gvector-method} 11 | \alias{\%*\%,gvector,logical-method} 12 | \alias{\%*\%,gvector,matrix-method} 13 | \alias{\%*\%,gvector,numeric-method} 14 | \alias{\%*\%,logical,gmatrix-method} 15 | \alias{\%*\%,logical,gvector-method} 16 | \alias{\%*\%,matrix,gmatrix-method} 17 | \alias{\%*\%,matrix,gvector-method} 18 | \alias{\%*\%,numeric,gmatrix-method} 19 | \alias{\%*\%,numeric,gvector-method} 20 | \title{Matrix Multiplication} 21 | \description{ 22 | Multiply two matrices together. 23 | } 24 | \section{Methods}{ 25 | \describe{ 26 | \item{\code{signature(x = "gmatrix", y = "gmatrix")}}{} 27 | \item{\code{signature(x = "gmatrix", y = "gvector")}}{} 28 | \item{\code{signature(x = "gmatrix", y = "logical")}}{} 29 | \item{\code{signature(x = "gmatrix", y = "matrix")}}{} 30 | \item{\code{signature(x = "gmatrix", y = "numeric")}}{} 31 | \item{\code{signature(x = "gvector", y = "gmatrix")}}{} 32 | \item{\code{signature(x = "gvector", y = "gvector")}}{} 33 | \item{\code{signature(x = "gvector", y = "logical")}}{} 34 | \item{\code{signature(x = "gvector", y = "matrix")}}{} 35 | \item{\code{signature(x = "gvector", y = "numeric")}}{} 36 | \item{\code{signature(x = "logical", y = "gmatrix")}}{} 37 | \item{\code{signature(x = "logical", y = "gvector")}}{} 38 | \item{\code{signature(x = "matrix", y = "gmatrix")}}{} 39 | \item{\code{signature(x = "matrix", y = "gvector")}}{} 40 | \item{\code{signature(x = "numeric", y = "gmatrix")}}{} 41 | \item{\code{signature(x = "numeric", y = "gvector")}}{} 42 | }} 43 | \keyword{methods} 44 | 45 | -------------------------------------------------------------------------------- /man/gmatrix.Rd: -------------------------------------------------------------------------------- 1 | \name{gmatrix} 2 | \alias{gmatrix} 3 | \title{ 4 | Create and object of class \code{gmatrix} 5 | } 6 | \description{ 7 | This function creates a \code{gmatrix} object from an input value. 8 | } 9 | \usage{ 10 | gmatrix(data = NA, nrow = 1L, ncol = 1L, byrow = FALSE, 11 | dimnames = NULL, type = NULL, dup = TRUE) 12 | } 13 | 14 | \arguments{ 15 | \item{data}{ 16 | The input data. Must be a \code{vector} or \code{gvector}. 17 | } 18 | \item{nrow}{ 19 | the desired number of rows 20 | } 21 | \item{ncol}{ 22 | the desired number of rows. 23 | } 24 | \item{byrow}{ 25 | logical. If FALSE (the default) the matrix is filled by columns, otherwise the matrix is filled by rows. 26 | } 27 | \item{dimnames}{ 28 | A dimnames attribute for the matrix: NULL or a list of length 2 giving the row and column names respectively. An empty list is treated as NULL. 29 | } 30 | \item{type}{ 31 | The type (i.e. \code{"double"}, \code{"single"}, \code{"integer"} or \code{"logical"}) 32 | } 33 | \item{dup}{ 34 | \code{dup=FALSE} will return the original data without duplicating it on the GPU. The \code{dup=FALSE} should only be used if the data in the input will not be used in it's original form again. 35 | } 36 | } 37 | \details{ 38 | This is implemented in a very similar fashion to the \code{matrix} function in R base. 39 | } 40 | \value{ 41 | returns a \code{gmatrix} object. 42 | } 43 | 44 | \author{ 45 | Nathan Morrris 46 | } 47 | 48 | \seealso{ 49 | \code{\link{matrix}} 50 | } 51 | \examples{ 52 | x=gmatrix(grnorm(100),10,10, type='d') #this makes an unneeded duplication 53 | x=gmatrix(grnorm(100),10,10, dup=FALSE) #this avoids the duplication 54 | 55 | #problematic code 56 | x=grnorm(100) 57 | y=as.gmatrix(x,10,10, dup=FALSE) #don't do this 58 | y[1,1]=100 #this changes both y and x because both point to the same spot in GPU memory 59 | x 60 | } 61 | 62 | \keyword{ gmatrix } 63 | 64 | -------------------------------------------------------------------------------- /man/normal.Rd: -------------------------------------------------------------------------------- 1 | \name{normal} 2 | \alias{gdnorm} 3 | \alias{grnorm} 4 | \alias{gqnorm} 5 | \alias{gpnorm} 6 | 7 | \title{ 8 | GPU Normal Distribution 9 | } 10 | \description{ 11 | Density, distribution function, quantile function and random generation for the normal distribution with mean equal to mean and standard deviation equal to sd. All functions performed on the GPU. 12 | } 13 | \usage{ 14 | gdnorm(x, mean = 0, sd = 1, log = FALSE, type = "d") 15 | grnorm(n, mean = 0, sd = 1, type = "d") 16 | gqnorm(q, mean = 0, sd = 1, lower.tail = TRUE, log.p = FALSE, 17 | warn = TRUE, type = "d") 18 | gpnorm(p, mean = 0, sd = 1, lower.tail = TRUE, log.p = FALSE, 19 | warn = TRUE, type = "d") 20 | } 21 | 22 | \arguments{ 23 | \item{x,q}{vector of quantiles} 24 | \item{p}{vector of probabilities} 25 | \item{n}{number of observations} 26 | \item{mean}{vector of means} 27 | \item{sd}{vector of standard deviations} 28 | \item{log, log.p}{logical; if TRUE, probabilities p are given as log(p)} 29 | \item{lower.tail}{logical; if TRUE (default), probabilities are P[X < x] otherwise, P[X > x].} 30 | \item{warn}{logical; if FALSE then additional warnings are disabled.} 31 | \item{type}{specify the type; may be \code{"double"}, \code{"single"} (or short form \code{"d"} or \code{"s"}) } 32 | } 33 | \details{ 34 | Very similar to the R stats functionality. However, \code{gqnorm} and \code{gpnorm} are implement currently in a way that is NOT numerically precise in the deep tails. Future releases may fix this problem. 35 | } 36 | \value{ 37 | \code{gdnorm} gives the density, \code{gpnorm} gives the distribution function, \code{gqnorm} gives the quantile function, and \code{grnorm} generates random deviates. 38 | } 39 | 40 | \author{ 41 | Nathan Morris 42 | } 43 | \seealso{ 44 | \code{\link{dnorm}} 45 | } 46 | \examples{ 47 | myRndNums1 = grnorm(100) #standard normals 48 | myRndNums2 = grnorm(100, mean=c(1,2), sd=c(1,2,4,6)) 49 | } 50 | \keyword{Normal} -------------------------------------------------------------------------------- /man/as.gmatrix-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{as.gmatrix, as.gvector} 2 | \alias{as.gmatrix} 3 | \alias{as.gmatrix-methods} 4 | \alias{as.gmatrix,ANY-method} 5 | \alias{as.gmatrix,gmatrix-method} 6 | \alias{as.gmatrix,gvector-method} 7 | \alias{as.gmatrix,matrix-method} 8 | \alias{as.gvector} 9 | \alias{as.gvector-methods} 10 | \alias{as.gvector,ANY-method} 11 | \alias{as.gvector,gmatrix-method} 12 | \alias{as.gvector,gvector-method} 13 | 14 | \title{Methods for coercing an object to a GPU class} 15 | \description{ 16 | The \code{as.gmatrix} and \code{as.gvector} methods may be used to coerce an object to a given GPU class (i.e. \code{gmatrix} or \code{gvector}). 17 | } 18 | %as.gmatrix(data, type=NULL, dup=TRUE) 19 | 20 | \arguments{ 21 | \item{x, data}{object to be coerced} 22 | \item{type}{The type to convert the object to. There are three different ways to specify this. One may use the \code{"double"}, \code{"single"}, \code{"integer"} or \code{"logical"} notation. Alternatively the short form \code{"d"}, \code{"s"}, \code{"i"} or \code{"s"} notation may be used. Finally the internal integer representation of 0L, 1L, 2L or 3L may be used.} 23 | \item{dup}{This may be set to 'FALSE' to avoid duplicating x in the event that it is on the GPU allready and the original type is the same as the type argument.} 24 | \item{nrow,ncol,byrow,dimnames}{these attributes should generally only be set by a direct call to \code{\link{gmatrix}}} 25 | 26 | } 27 | 28 | \details{ 29 | The \code{as.gmatrix} and \code{as.gvector} methods may be used to move an R object to the current GPU device and returns an object of class 30 | \code{gmatrix} or \code{gvector} respectively. The methods have the following arguments: 31 | 32 | as.gmatrix(data = NA, nrow = 1L, ncol = 1L, byrow = FALSE, 33 | dimnames = NULL, type = NULL, dup = TRUE) 34 | as.gvector(x, type=NULL, dup=TRUE) 35 | 36 | The \code{dup} argument is used only when the input argument (\code{data}) is all ready on the GPU. 37 | \code{dup=FALSE} will return the original data without duplicating it on the GPU. 38 | } 39 | 40 | \value{ 41 | An object of type \code{gmatrix} or \code{gvector} 42 | } 43 | 44 | \author{ 45 | Nathan Morris 46 | } 47 | \seealso{ 48 | \code{\link{g}}, \code{\link{gmatrix}} and \code{\link{gvector}} 49 | } 50 | \examples{ 51 | A=matrix(1:10,2,5) 52 | B=as.gmatrix(A) 53 | 54 | } 55 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | useDynLib(gmatrix, .registration=TRUE) 2 | 3 | exportPattern("^[^\\.]") 4 | 5 | 6 | exportClasses("gmatrix", "gvector", "gqr", "gsvd", "lpgr") 7 | importFrom("methods", getMethod, "callNextMethod", "new", "show", "cbind2", "rbind2") 8 | importFrom("stats", "approxfun", "dbeta", "dbinom", "dgamma", "dnorm", 9 | "dpois", "dunif", "pbinom", "pchisq", "pnorm", "ppois", 10 | "qbeta", "qbinom", "qgamma", "qnorm", "qpois", "qunif", 11 | "rnorm", "runif") 12 | 13 | exportMethods( 14 | "^", 15 | "-", 16 | "[", 17 | "*", 18 | "/", 19 | "%*%", 20 | "+", 21 | "abs", 22 | "acos", 23 | "acosh", 24 | "as.gmatrix", 25 | "as.gvector", 26 | "as.matrix", 27 | "as.numeric", 28 | "as.vector", 29 | "asin", 30 | "asinh", 31 | "atan", 32 | "atanh", 33 | "cos", 34 | "cosh", 35 | "crossprod", 36 | "diag", 37 | "diag<-", 38 | "dim", 39 | "dim<-", 40 | "exp", 41 | "expm1", 42 | "gamma", 43 | "length", 44 | "lgamma", 45 | "log", 46 | "log10", 47 | "log1p", 48 | "log2", 49 | "ncol", 50 | "nrow", 51 | "show", 52 | "sin", 53 | "sinh", 54 | "sqrt", 55 | "t", 56 | "tan", 57 | "tanh", 58 | "tcrossprod", 59 | "names", 60 | "names<-", 61 | "sum", 62 | "mean", 63 | "dimnames<-", 64 | "rownames<-", 65 | "colnames<-", 66 | "dimnames", 67 | "rownames", 68 | "colnames", 69 | 'round', 70 | 'ceiling', 71 | 'floor', 72 | 'is.na', 73 | 'is.nan', 74 | 'is.finite', 75 | 'is.infinite', 76 | 'qr', 77 | 'gqr.coef', 78 | 'solve', 79 | 'svd', 80 | 'chol', 81 | 'rbind2', 82 | 'cbind2', 83 | "sqrtIp", 84 | "expIp", 85 | "expm1Ip", 86 | "logIp", 87 | "log2Ip", 88 | "log10Ip", 89 | "log1pIp", 90 | "sinIp", 91 | "cosIp", 92 | "tanIp", 93 | "asinIp", 94 | "acosIp", 95 | "atanIp", 96 | "sinhIp", 97 | "coshIp", 98 | "tanhIp", 99 | "asinhIp", 100 | "acoshIp", 101 | "atanhIp", 102 | "absIp", 103 | "lgammaIp", 104 | "gammaIp", 105 | "signIp") 106 | 107 | 108 | 109 | ## So that such dispatch also works inside base functions: 110 | S3method(as.matrix, gmatrix) 111 | S3method(as.vector, gmatrix) 112 | 113 | 114 | S3method(as.matrix, gvector) 115 | S3method(as.vector, gvector) 116 | -------------------------------------------------------------------------------- /man/gmatrix-package.Rd: -------------------------------------------------------------------------------- 1 | \name{gmatrix-package} 2 | \alias{gmatrix-package} 3 | %\alias{gmatrix} 4 | \docType{package} 5 | \title{ 6 | Making GPU power available in R 7 | } 8 | \description{ 9 | This package implements a general framework for utilizing R to harness the power 10 | of NVIDIA GPU's. The \code{gmatrix} and \code{gvector} classes allow for easy management 11 | of the separate device and host memory spaces. Numerous numerical operations are 12 | implemented for these objects on the GPU. These operations include matrix 13 | multiplication, addition, subtraction, the kronecker product, the outer product, 14 | comparison operators, logical operators, trigonometric functions, indexing, sorting, 15 | random number generation and many more. 16 | } 17 | \details{ 18 | \tabular{ll}{ 19 | Package: \tab gmatrix\cr 20 | Type: \tab Package\cr 21 | Version: \tab 0.1\cr 22 | Date: \tab 2013-5-10\cr 23 | License: \tab GPL-2\cr 24 | LazyLoad: \tab yes\cr 25 | Depends: \tab methods\cr 26 | } 27 | To move an R object to the GPU use the \code{g} function. To move the object back the the host use the \code{h} function. 28 | Standard operations such as matrix multiplication or addition may be performed on GPU objects as with any \code{matrix} or \code{vector} object in R. 29 | The \code{gmatrix} and \code{gvector} classes contain a \code{type} slot which determines if the data is stored as a \code{"double"}, \code{"single"}, \code{"integer"} or \code{"logical."} 30 | The \code{gmatrix} and \code{gvector} objects store only a pointer to an object on the GPU device. Thus, a line such as \code{y<-x} will duplicate the pointer but not the actual data on the GPU. One should use instead \code{y<-gdup(x)}. 31 | Numerous random number generators such as \code{grnorm} have been implemented in this package. This package is intended to work with the companion package \code{rcula} which implements matrix factorization and inversions methods. 32 | } 33 | \author{ 34 | Nathan Morris 35 | } 36 | \references{ 37 | None 38 | } 39 | 40 | \keyword{NVIDIA} 41 | \keyword{GPU} 42 | 43 | \seealso{ 44 | \code{rcula-package}, \code{\link{g}}, \code{\link{h}}, \code{\link{gmatrix-class}}, \code{\link{gvector-class}} 45 | } 46 | \examples{ 47 | #Look at available GPU devices (use setDevice to change the device) 48 | listDevices() 49 | 50 | #Creating GPU objects 51 | g_x=g(1:10) #transfer a sequence to the GPU 52 | g_y=gseq(1,10) #create a sequence on the GPU 53 | g_A=gmatrix(grnorm(100),10,10,dup=FALSE) #create a random 10x10 matrix 54 | 55 | #look at and change the properties of these objects 56 | type(g_x) 57 | type(g_A) 58 | type(g_x)="d" #'d' may be used as short form of"double" 59 | length(g_x) 60 | dim(g_A) 61 | nrow(g_A) 62 | 63 | #Perform some simple calculations 64 | g_ans=g_x \%*\% log(abs(g_A)) \%*\% sin(-g_y) 65 | g_rowsum= rowSums(g_A) 66 | 67 | #Move data back to the host 68 | h_ans=h(g_x) 69 | h_roswum =h(g_A) 70 | } 71 | -------------------------------------------------------------------------------- /src/conversions.cu: -------------------------------------------------------------------------------- 1 | 2 | #include "gmatrix.h" 3 | 4 | /* 5 | template 6 | __device__ T R_NA3(void) { 7 | return CUDA_R_Na_float ; 8 | } 9 | 10 | template <> 11 | __device__ double R_NA3(void) { 12 | return CUDA_R_Na_double; 13 | } 14 | 15 | template <> 16 | __device__ int R_NA3(void) { 17 | return CUDA_R_Na_int; 18 | }*/ 19 | 20 | 21 | 22 | template 23 | __global__ void kernal_convert(T1* y, T2* x, int ny, int operations_per_thread) 24 | { 25 | int mystop = blockDim.x * (blockIdx.x+1) * operations_per_thread; 26 | for ( int i = blockDim.x * blockIdx.x * operations_per_thread + threadIdx.x; 27 | i < mystop; i+=blockDim.x) { 28 | if (i < ny) { 29 | T2 tmpx=x[i]; 30 | T1 tmpy; 31 | if(IS_NAN(tmpx)) { 32 | if(IS_NA(&(tmpx))) 33 | MAKE_NA(&(tmpy)); 34 | else 35 | tmpy=RET_NAN(); 36 | } else 37 | tmpy= (T1) tmpx; 38 | y[i]=tmpy; 39 | } 40 | } 41 | } 42 | 43 | 44 | 45 | SEXP gpu_convert(SEXP A_in, SEXP in_N, SEXP in_type, SEXP in_to_type ) 46 | { 47 | SEXP ptr; 48 | struct gpuvec *A = (struct gpuvec*) R_ExternalPtrAddr(A_in); 49 | struct gpuvec *my_gpuvec = Calloc(1, struct gpuvec); 50 | 51 | //int n = length(in_vec); 52 | int N = INTEGER(in_N)[0]; 53 | 54 | DECERROR1; 55 | 56 | //check the from and to types 57 | int type = INTEGER(in_type)[0]; 58 | if(type > 3) 59 | error("Incorrect type passed to '%s.'", __func__); 60 | 61 | int to_type = INTEGER(in_to_type)[0]; 62 | int to_mysizeof; 63 | if(to_type==0) 64 | to_mysizeof=sizeof(double); 65 | else if(to_type==1) 66 | to_mysizeof=sizeof(float); 67 | else if(to_type==2 || to_type==3) 68 | to_mysizeof=sizeof(int); 69 | else 70 | error("Incorrect type passed to '%s.'", __func__); 71 | 72 | 73 | 74 | //#ifdef DEBUG 75 | // Rprintf("length = %d\n", n); 76 | //#endif 77 | CUDA_MALLOC( my_gpuvec->d_vec, N*to_mysizeof ); 78 | 79 | 80 | if(to_type==0) { 81 | #define KERNAL(PTR,T)\ 82 | GET_BLOCKS_PER_GRID(N, (kernal_convert));\ 83 | kernal_convert<<>>((double *) (my_gpuvec->d_vec), PTR(A), N, operations_per_thread); 84 | CALL_KERNAL; 85 | #undef KERNAL 86 | } else if(to_type==1) { 87 | #define KERNAL(PTR,T)\ 88 | GET_BLOCKS_PER_GRID(N, (kernal_convert));\ 89 | kernal_convert<<>>((float *) (my_gpuvec->d_vec), PTR(A), N, operations_per_thread); 90 | CALL_KERNAL; 91 | #undef KERNAL 92 | } else { 93 | #define KERNAL(PTR,T)\ 94 | GET_BLOCKS_PER_GRID(N, (kernal_convert));\ 95 | kernal_convert<<>>((int *) (my_gpuvec->d_vec), PTR(A), N, operations_per_thread); 96 | CALL_KERNAL; 97 | #undef KERNAL 98 | } 99 | CUDA_CHECK_KERNAL_CLEAN_1(my_gpuvec->d_vec); 100 | 101 | 102 | ptr = gpu_register(my_gpuvec); 103 | return(ptr); 104 | } 105 | -------------------------------------------------------------------------------- /configure.ac: -------------------------------------------------------------------------------- 1 | # This a a modified version of the 'configure.ac' from 2 | # the 'magma' R package by Brian Smith which is licensed by 3 | # under GNU GPL 3 or later. 4 | 5 | AC_INIT([gmatrix], 0.3.0) 6 | AC_CONFIG_AUX_DIR([tools]) 7 | 8 | #################### GCC Compiler #################### 9 | 10 | AC_PROG_CC(gcc) 11 | 12 | #################### CUDA Toolkit #################### 13 | : ${CUDA_TMP=`which nvcc`} 14 | AC_ARG_WITH([cuda-home], 15 | [AC_HELP_STRING([--with-cuda-home=DIR], 16 | [full path to CUDA installation @<:@which nvcc@:>@])], 17 | [CUDA_HOME="$withval"], [CUDA_HOME=${CUDA_TMP%%nvcc}..]) 18 | AC_MSG_RESULT([setting CUDA home directory to ${CUDA_HOME}]) 19 | 20 | NVCC=${CUDA_HOME}/bin/nvcc 21 | AC_CHECK_FILE([${NVCC}],, 22 | [AC_MSG_ERROR([nvcc not found!])]) 23 | 24 | AC_ARG_WITH([arch], 25 | [AC_HELP_STRING([--with-arch=SM], 26 | [compute capability of the target device @<:@sm_20@:>@])], 27 | [ARCH="$withval"], [ARCH=sm_20]) 28 | AC_MSG_RESULT([setting compute capability of the target device to ${ARCH}]) 29 | 30 | 31 | NCFLAGS="-arch=${ARCH} -O2 -DADD_" 32 | CUDA_INC=${CUDA_HOME}/include 33 | AC_MSG_CHECKING([for CUDA headers]) 34 | AC_CHECK_FILE([${CUDA_INC}/cublas_v2.h], 35 | [NCFLAGS="${NCFLAGS} -I${CUDA_INC}"], 36 | [AC_MSG_ERROR([CUDA headers not found!])] 37 | ) 38 | 39 | AC_MSG_CHECKING([whether this is a 64-bit version of CUDA]) 40 | AC_CHECK_FILE([${CUDA_HOME}/lib64/libcublas.so], [check_bit=64-bit]) 41 | if test "${check_bit}" == "64-bit"; then 42 | LDFLAGS="-shared -L${CUDA_HOME}/lib64" 43 | else 44 | LDFLAGS="-shared -L${CUDA_HOME}/lib" 45 | fi 46 | 47 | AC_MSG_CHECKING([whether cusolver is used]) 48 | AC_CHECK_FILE([${CUDA_INC}/cusolverDn.h], [check_cusolve=T]) 49 | if test "${check_cusolve}" == "T"; then 50 | LIBS="-lcudart -lcublas -lcusolver" 51 | else 52 | LIBS="-lcudart -lcublas" 53 | fi 54 | 55 | 56 | 57 | 58 | #################### R Software #################### 59 | 60 | : ${R_HOME=`R RHOME`} 61 | AC_ARG_WITH([r-home], 62 | [AC_HELP_STRING([--with-r-home=DIR], 63 | [full path to R installation @<:@R RHOME@:>@])], 64 | [R_HOME=$withval] 65 | ) 66 | AC_MSG_RESULT([setting R home directory to ${R_HOME}]) 67 | AC_CHECK_PROG([check_R], [R], [yes],, [${R_HOME}/bin]) 68 | if test -z "${check_R}"; then 69 | AC_MSG_ERROR([R not found!]) 70 | fi 71 | 72 | R_INCLUDE_DIR=$(R --slave --no-save -e "cat('Unique123',R.home('include'),sep=':')" | grep Unique123) 73 | R_INCLUDE_DIR=${R_INCLUDE_DIR#*:} 74 | AC_ARG_WITH([r-include], 75 | [AC_HELP_STRING([--with-r-include=DIR], 76 | [full path to R include files @<:@R --slave --no-save -e "cat(R.home('include'))"@:>@])], 77 | [R_INCLUDE_DIR=$withval] 78 | ) 79 | AC_MSG_RESULT([setting R header files to ${R_INCLUDE_DIR}]) 80 | 81 | R_CPICFLAGS=`"${R_HOME}/bin/R" CMD config CPICFLAGS` 82 | NCFLAGS="${NCFLAGS} -Xcompiler \"-O2 -DADD_ ${R_CPICFLAGS} -I${R_INCLUDE_DIR}\"" 83 | NCFLAGS="${NCFLAGS//[$'\t\r\n ']}" 84 | 85 | AC_CANONICAL_HOST 86 | # Check for which host we are on and setup a few things 87 | case $host_os in 88 | darwin* ) 89 | TMPLDFLAGS=`R CMD config --ldflags` 90 | LDFLAGS="${LDFLAGS} -Xlinker \"${TMPLDFLAGS}\"" 91 | ;; 92 | esac 93 | 94 | AC_SUBST([NVCC]) 95 | AC_SUBST([NCFLAGS]) 96 | AC_SUBST([LDFLAGS]) 97 | AC_SUBST([LIBS]) 98 | 99 | AC_CONFIG_FILES([src/Makefile]) 100 | AC_OUTPUT -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | The "gmatrix" Package 2 | ================================================= 3 | 4 | This package implements a general framework for utilizing R to harness the power of NVIDIA GPU's. The "gmatrix" and "gvector" classes allow for easy management of the separate device and host memory spaces. Numerous numerical operations are implemented for these objects on the GPU. These operations include matrix multiplication, addition, subtraction, the kronecker product, the outer product, comparison operators, logical operators, trigonometric functions, indexing, sorting, random number generation and many more. 5 | The "gmatrix" package has only been tested and compiled for linux machines. It would certainly be nice of someone to get it working in Windows. Until then, Windows is not supported. 6 | In addition we assume that the divice is at least of NVIDIA(R) compute capibility 2.0, so this package may not work with older devices. 7 | 8 | Installation Instructions 9 | ------------------------- 10 | 1. Install the the CUDA Toolkit. The current version of 'gmatix' has been tested for CUDA Toolkit 5.0 and 7.0. 11 | 2. Install R. The current version of 'gmatrix' has been tested under R 3.0.2 and 3.2.2. 12 | 3. Start R and then install the 'gmatrix' package with the following commands. Package compilation may take 5-10 minutes. 13 | 14 | ``` 15 | install.packages("gmatrix") 16 | ``` 17 | 18 | Alternatively, if you would like to install the developmental version, the following from the linux command line may be used: 19 | 20 | git clone https://github.com/njm18/gmatrix.git 21 | rm ./gmatrix/.git -rf 22 | MAKE="make -j7" #note this make the compile process use 7 threads 23 | R CMD INSTALL gmatrix 24 | 25 | 26 | Installation Note 27 | ----------------- 28 | By default, when compiling, the build process assumes that 29 | + The nvcc compiler is in the PATH, and that the the CUDA library files may be located based on the location of nvcc. 30 | + R is located in the PATH, and: 31 | + The R home directory may be located using the command: R RHOME 32 | + The R include director may be located using the command: R --slave --no-save -e "cat(R.home('include'))". 33 | + The compute capability of the target device is 2.0. 34 | 35 | If these are incorrect assumptions, the user may set these values and install using the following R command as an example. 36 | 37 | ``` 38 | install.packages("gmatrix" , 39 | configure.args = " 40 | --with-arch=sm_30 41 | --with-cuda-home=/opt/cuda 42 | --with-r-home=/opt/R 43 | --with-r-include=/opt/R/include/x64" 44 | ) 45 | ``` 46 | Alternatively, from the command line, use a cammand such as: 47 | 48 | ``` 49 | R CMD INSTALL gmatrix --configure-args="--with-arch=sm_35" 50 | ``` 51 | 52 | Testing the Installation 53 | ------------------------- 54 | We recomend that the user test the installation using the following commands: 55 | 56 | library(gmatrix) 57 | gtest() 58 | 59 | Please report any errors to the package maintainer. 60 | 61 | Getting Started 62 | --------------- 63 | + Load the library for each sessesion using: library(gmatrix) 64 | + To list available gpu devices use: listDevices() 65 | + To set the device use: setDevice() 66 | + To move object to the device use: g() 67 | + To move object to the host use: h() 68 | + Object on the device can be manipulated in much the same way other R objects can. 69 | + A list of help topics may be optained using: help(package="gmatrix") -------------------------------------------------------------------------------- /man/crossprod-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{crossprod,tcrossprod} 2 | \docType{methods} 3 | \alias{crossprod-methods} 4 | \alias{crossprod,ANY,ANY-method} 5 | \alias{crossprod,gmatrix,gmatrix-method} 6 | \alias{crossprod,gmatrix,gvector-method} 7 | \alias{crossprod,gmatrix,logical-method} 8 | \alias{crossprod,gmatrix,matrix-method} 9 | \alias{crossprod,gmatrix,missing-method} 10 | \alias{crossprod,gmatrix,numeric-method} 11 | \alias{crossprod,gvector,gmatrix-method} 12 | \alias{crossprod,gvector,gvector-method} 13 | \alias{crossprod,gvector,logical-method} 14 | \alias{crossprod,gvector,missing-method} 15 | \alias{crossprod,gvector,numeric-method} 16 | \alias{crossprod,logical,gmatrix-method} 17 | \alias{crossprod,logical,gvector-method} 18 | \alias{crossprod,matrix,gmatrix-method} 19 | \alias{crossprod,numeric,gmatrix-method} 20 | \alias{crossprod,numeric,gvector-method} 21 | \alias{crossprod,gvector,matrix-method} 22 | \alias{crossprod,matrix,gvector-method} 23 | 24 | \alias{tcrossprod-methods} 25 | \alias{tcrossprod,ANY,ANY-method} 26 | \alias{tcrossprod,gmatrix,gmatrix-method} 27 | \alias{tcrossprod,gmatrix,gvector-method} 28 | \alias{tcrossprod,gmatrix,logical-method} 29 | \alias{tcrossprod,gmatrix,matrix-method} 30 | \alias{tcrossprod,gmatrix,missing-method} 31 | \alias{tcrossprod,gmatrix,numeric-method} 32 | \alias{tcrossprod,gvector,gmatrix-method} 33 | \alias{tcrossprod,gvector,gvector-method} 34 | \alias{tcrossprod,gvector,logical-method} 35 | \alias{tcrossprod,gvector,missing-method} 36 | \alias{tcrossprod,gvector,numeric-method} 37 | \alias{tcrossprod,logical,gmatrix-method} 38 | \alias{tcrossprod,logical,gvector-method} 39 | \alias{tcrossprod,matrix,gmatrix-method} 40 | \alias{tcrossprod,numeric,gmatrix-method} 41 | \alias{tcrossprod,numeric,gvector-method} 42 | \alias{tcrossprod,gvector,matrix-method} 43 | \alias{tcrossprod,matrix,gvector-method} 44 | \title{Matrix Crossproduct} 45 | \description{ 46 | Given matrices x and y as arguments, return a matrix cross-product. This is formally equivalent to (but usually slightly faster than) the call \code{t(x) \%*\% y} (crossprod) or \code{x \%*\% t(y)} (tcrossprod). 47 | } 48 | \section{Methods}{ 49 | \describe{ 50 | \item{\code{signature(x = "ANY", y = "ANY")}}{} 51 | \item{\code{signature(x = "gmatrix", y = "gmatrix")}}{} 52 | \item{\code{signature(x = "gmatrix", y = "gvector")}}{} 53 | \item{\code{signature(x = "gmatrix", y = "logical")}}{} 54 | \item{\code{signature(x = "gmatrix", y = "matrix")}}{} 55 | \item{\code{signature(x = "gmatrix", y = "missing")}}{} 56 | \item{\code{signature(x = "gmatrix", y = "numeric")}}{} 57 | \item{\code{signature(x = "gvector", y = "gmatrix")}}{} 58 | \item{\code{signature(x = "gvector", y = "gvector")}}{} 59 | \item{\code{signature(x = "gvector", y = "logical")}}{} 60 | \item{\code{signature(x = "gvector", y = "missing")}}{} 61 | \item{\code{signature(x = "gvector", y = "numeric")}}{} 62 | \item{\code{signature(x = "logical", y = "gmatrix")}}{} 63 | \item{\code{signature(x = "logical", y = "gvector")}}{} 64 | \item{\code{signature(x = "matrix", y = "gmatrix")}}{} 65 | \item{\code{signature(x = "numeric", y = "gmatrix")}}{} 66 | \item{\code{signature(x = "numeric", y = "gvector")}}{} 67 | \item{\code{signature(x = "ANY", y = "ANY")}}{} 68 | \item{\code{signature(x = "gmatrix", y = "gmatrix")}}{} 69 | \item{\code{signature(x = "gmatrix", y = "gvector")}}{} 70 | \item{\code{signature(x = "gmatrix", y = "logical")}}{} 71 | \item{\code{signature(x = "gmatrix", y = "matrix")}}{} 72 | \item{\code{signature(x = "gmatrix", y = "missing")}}{} 73 | \item{\code{signature(x = "gmatrix", y = "numeric")}}{} 74 | \item{\code{signature(x = "gvector", y = "gmatrix")}}{} 75 | \item{\code{signature(x = "gvector", y = "gvector")}}{} 76 | \item{\code{signature(x = "gvector", y = "logical")}}{} 77 | \item{\code{signature(x = "gvector", y = "missing")}}{} 78 | \item{\code{signature(x = "gvector", y = "numeric")}}{} 79 | \item{\code{signature(x = "logical", y = "gmatrix")}}{} 80 | \item{\code{signature(x = "logical", y = "gvector")}}{} 81 | \item{\code{signature(x = "matrix", y = "gmatrix")}}{} 82 | \item{\code{signature(x = "numeric", y = "gmatrix")}}{} 83 | \item{\code{signature(x = "numeric", y = "gvector")}}{} 84 | }} 85 | \keyword{methods} 86 | 87 | -------------------------------------------------------------------------------- /man/MathMethods.Rd: -------------------------------------------------------------------------------- 1 | \name{elementwise functions} 2 | \docType{methods} 3 | \alias{abs-methods} 4 | \alias{abs,gmatrix-method} 5 | \alias{abs,gvector-method} 6 | 7 | \alias{sqrt-methods} 8 | \alias{sqrt,gmatrix-method} 9 | \alias{sqrt,gvector-method} 10 | 11 | \alias{exp-methods} 12 | \alias{exp,gmatrix-method} 13 | \alias{exp,gvector-method} 14 | 15 | \alias{expm1-methods} 16 | \alias{expm1,gmatrix-method} 17 | \alias{expm1,gvector-method} 18 | 19 | \alias{log-methods} 20 | \alias{log,gmatrix-method} 21 | \alias{log,gvector-method} 22 | 23 | \alias{log2-methods} 24 | \alias{log2,gmatrix-method} 25 | \alias{log2,gvector-method} 26 | 27 | \alias{log10-methods} 28 | \alias{log10,gmatrix-method} 29 | \alias{log10,gvector-method} 30 | 31 | \alias{log1p-methods} 32 | \alias{log1p,gmatrix-method} 33 | \alias{log1p,gvector-method} 34 | 35 | \alias{sin-methods} 36 | \alias{sin,gmatrix-method} 37 | \alias{sin,gvector-method} 38 | 39 | \alias{cos-methods} 40 | \alias{cos,gmatrix-method} 41 | \alias{cos,gvector-method} 42 | 43 | \alias{tan-methods} 44 | \alias{tan,gmatrix-method} 45 | \alias{tan,gvector-method} 46 | 47 | \alias{asin-methods} 48 | \alias{asin,gmatrix-method} 49 | \alias{asin,gvector-method} 50 | 51 | \alias{acos-methods} 52 | \alias{acos,gmatrix-method} 53 | \alias{acos,gvector-method} 54 | 55 | \alias{atan-methods} 56 | \alias{atan,gmatrix-method} 57 | \alias{atan,gvector-method} 58 | 59 | \alias{sinh-methods} 60 | \alias{sinh,gmatrix-method} 61 | \alias{sinh,gvector-method} 62 | 63 | \alias{cosh-methods} 64 | \alias{cosh,gmatrix-method} 65 | \alias{cosh,gvector-method} 66 | 67 | \alias{tanh-methods} 68 | \alias{tanh,gmatrix-method} 69 | \alias{tanh,gvector-method} 70 | 71 | \alias{asinh-methods} 72 | \alias{asinh,gmatrix-method} 73 | \alias{asinh,gvector-method} 74 | 75 | \alias{acosh-methods} 76 | \alias{acosh,gmatrix-method} 77 | \alias{acosh,gvector-method} 78 | 79 | \alias{atanh-methods} 80 | \alias{atanh,gmatrix-method} 81 | \alias{atanh,gvector-method} 82 | 83 | \alias{abs-methods} 84 | \alias{abs,gmatrix-method} 85 | \alias{abs,gvector-method} 86 | 87 | \alias{lgamma-methods} 88 | \alias{lgamma,gmatrix-method} 89 | \alias{lgamma,gvector-method} 90 | 91 | \alias{gamma-methods} 92 | \alias{gamma,gmatrix-method} 93 | \alias{gamma,gvector-method} 94 | 95 | \alias{sign-methods} 96 | \alias{sign,gmatrix-method} 97 | \alias{sign,gvector-method} 98 | 99 | \alias{round-methods} 100 | \alias{round,gmatrix-method} 101 | \alias{round,gvector-method} 102 | 103 | \alias{ceiling-methods} 104 | \alias{ceiling,gmatrix-method} 105 | \alias{ceiling,gvector-method} 106 | 107 | \alias{floor-methods} 108 | \alias{floor,gmatrix-method} 109 | \alias{floor,gvector-method} 110 | 111 | \alias{is.na-methods} 112 | \alias{is.na,gmatrix-method} 113 | \alias{is.na,gvector-method} 114 | 115 | \alias{is.nan-methods} 116 | \alias{is.nan,gmatrix-method} 117 | \alias{is.nan,gvector-method} 118 | 119 | \alias{is.finite-methods} 120 | \alias{is.finite,gmatrix-method} 121 | \alias{is.finite,gvector-method} 122 | 123 | \alias{is.infinite-methods} 124 | \alias{is.infinite,gmatrix-method} 125 | \alias{is.infinite,gvector-method} 126 | 127 | \alias{!-methods} 128 | \alias{!,gmatrix-method} 129 | \alias{!,gvector-method} 130 | 131 | \title{Elementwise functions/operators} 132 | \description{ 133 | This is the documentation for the functions \code{abs}, \code{exp}, \code{expm1}, \code{log}, \code{log2}, \code{log10}, \code{log1p}, 134 | \code{sin}, \code{cos}, \code{tan}, \code{asin}, \code{acos}, \code{atan}, 135 | \code{sinh}, \code{cosh}, \code{tanh}, \code{asinh}, \code{acosh}, \code{atanh}, 136 | \code{abs}, \code{lgamma}, \code{gamma}, \code{sign}, \code{round}, \code{ceiling}, 137 | \code{is.na}, \code{is.nan}, \code{is.finite}, \code{is.infinite} and \code{!}. 138 | These functions are elementwise functions/operators which are defined much the same as the functions the R base package. When operation on 139 | object of class gmatrix or gvector the work will be performed by the GPU and will return a GPU object of the same dimension as the input. 140 | } 141 | \section{Methods}{ 142 | \describe{ 143 | \item{\code{signature(x = "gmatrix")}}{ Returns an object of type gmatrix with the same dimensions as the input.} 144 | \item{\code{signature(x = "gvector")}}{ Returns an object of type gvector with the same dimensions as the input.} 145 | 146 | }} 147 | \keyword{methods} 148 | \keyword{Trig} 149 | -------------------------------------------------------------------------------- /man/gBasicHMC.Rd: -------------------------------------------------------------------------------- 1 | \name{gBasicHMC} 2 | \alias{gBasicHMC} 3 | \alias{keep} 4 | \title{ 5 | Performing Hamiltonian MCMC 6 | } 7 | \description{ 8 | This function performs Hamiltonian MCMC for continuous distributions. 9 | } 10 | 11 | \usage{ 12 | gBasicHMC(lpgrf, initial, nsims, nsteps, step, 13 | burnin = 1, nstepsburnin = nsteps, stepburnin = step, 14 | Tstart = 1, r = 1, 15 | keep=keep, thin = 1, report = 100) 16 | } 17 | 18 | \arguments{ 19 | \item{lpgrf}{ 20 | This \code{lpgrf} input must be a function which takes as its input a list of parameters and gives as its output the log probability (\code{lp}) excluding the normalization constant and a first derivative of the log probability (\code{gr}). Both the \code{lp} and \code{gr} information must be returned as slots in an object of class \code{lpgr}. See details. 21 | } 22 | \item{initial}{ 23 | Starting values as a list. Again each element of the starting value must be a matrix on the CPU or GPU. The number columns of each matrix is the number of parrallel runs. 24 | } 25 | \item{nsims}{ 26 | Total number of simulations includeing burnin. 27 | } 28 | \item{nsteps}{ 29 | Tuning parameter for HMC representing the number of leepfrog steps for each iteration. 30 | } 31 | \item{step}{ 32 | Tuning parameter for HMC controls the length of each leepfrog steps for each iteration. 33 | } 34 | \item{nstepsburnin}{ 35 | Tuning parameter for HMC representing the number of leepfrog steps for each iteration. This parameter is used only during burnin. 36 | } 37 | \item{stepburnin}{ 38 | Tuning parameter for HMC controls the length of each leepfrog steps for each iteration. This parameter is used only during burnin. 39 | } 40 | \item{Tstart}{ 41 | During the burnin phase only tempering is used to get the simulation moving. Tstart is the starting temperature. 42 | } 43 | \item{r}{ 44 | The temperature during the burning phase is exponentially decreased at a rate \code{r}. The temperature is set to 1 if it drops below 1. Also, the temperature is set to 1 once the burnin phas is done. 45 | } 46 | \item{burnin}{ 47 | The number of iterations used for burnin. All burnin samples are discarded. 48 | } 49 | \item{keep}{ 50 | Function to extract samples to keep. If defualt keep function is defined as \code{keep = function(q) lapply(q, function(x) if(any(class(x) \%in\% c("gmatrix","gvector"))) g(x) else x)}. 51 | } 52 | \item{thin}{ 53 | Selects the number of samples to keep. \code{thin=1} keeps all the samples. \code{thin=5} keeps only ever fifth sample. 54 | } 55 | \item{report}{ 56 | Controls how often an update of the progress is printed out. 57 | } 58 | } 59 | \details{ 60 | The most important input of \code{gBasicHMC()} is the \code{lpgrf} parameter. This \code{lpgrf} input must be a function which takes as its input a list of parameters and gives as its output the log probability (\code{lp}) excluding the normalization constant and a first derivative of the log probability (\code{gr}). Both the \code{lp} and \code{gr} information must be returned as slots in an object of class \code{lpgrf}. The \code{lp} slot must be a numberic CPU vector while \code{gr} slot must be a list with elements either on the CPU or GPU.The function \code{gBasicHMC()} is designed to run multiple chains simultaneously. Thus each element in the input is expected to be a matrix where the number of columns is the number of parallel chains and the number of rows is the dimension of the random variable being simulated. The input is assumed to be a list of parameters because in many cases there are different types of parameters such as hyper-parameters. Tracking the current stated of the chain using a list is therefore often quite natural. As a result of this convention, the \code{gr} slot for \code{lpgr} object returned by the \code{lpgrf} function must also be a list. 61 | } 62 | \value{ 63 | Output is a list: 64 | \item{sims }{A list with the simulation results from each iteration as elements.} 65 | \item{lp }{A matrix with the simulation log probabilities for all simulations.} 66 | \item{AcceptanceRate }{Acceptence rate for each parallel chain.} 67 | \item{BurninAcceptanceRate }{Acceptence rate during the burnin phase for each parallel chain.} 68 | } 69 | \references{ 70 | Neal, Radford M. "MCMC using Hamiltonian dynamics." Handbook of Markov Chain Monte Carlo 2 (2011). 71 | 72 | Beam, Andrew L., Sujit K. Ghosh, and Jon Doyle. "Fast hamiltonian monte carlo using gpu computing." Journal of Computational and Graphical Statistics just-accepted (2015): 00-00. 73 | } 74 | \author{ 75 | Nathan Morris (this is actually a significantly modified version of an HMC implementation created by Radford Neal: http://www.cs.utoronto.ca/~radford/GRIMS.html) 76 | } 77 | 78 | 79 | \seealso{ 80 | \link{lpgr-class} 81 | } 82 | 83 | \keyword{ MCMC } 84 | \keyword{ HMC } 85 | -------------------------------------------------------------------------------- /R/06solve.R: -------------------------------------------------------------------------------- 1 | ########################################################################### 2 | # Test Script 3 | # 4 | # Author: nmorris 5 | ############################################################################### 6 | 7 | setClass("gqr", 8 | representation( 9 | qr="gmatrix", 10 | qraux = "gvector"), 11 | prototype = list( 12 | qr=NULL, 13 | qraux=NULL) 14 | ) 15 | 16 | 17 | 18 | 19 | setGeneric("gqr.coef", function(qr,y) stop("'gqr.coef' can only act on an object of class 'gqr.'")) 20 | setMethod("gqr.coef", signature(qr = "gqr", y = "ANY"), 21 | function(qr, y) 22 | { 23 | #browser() 24 | if(qr@qr@type>1L) 25 | type(qr@qr)=0L 26 | if(qr@qraux@type>1L) 27 | type(qr@qraux)=0L 28 | if(qr@qr@type!=qr@qraux@type) { 29 | totype=min(c(qr@qr@type,qr@qraux@type)) 30 | type(qr@qr)=totype 31 | type(qr@qraux)=totype 32 | } 33 | 34 | if (class(y)!="gmatrix") 35 | y <- as.gmatrix(y) 36 | else 37 | y=gdup(y) 38 | 39 | if(y@type>1L) 40 | type(y)=type(qr@qr) 41 | if(y@type!=qr@qr@type) 42 | stop("Type mismatch.") 43 | if(qr@qraux@type!=qr@qr@type) 44 | stop("Type mismatch.") 45 | 46 | checkDevice(c(y@device,qr@qr@device,qr@qraux@device)) 47 | 48 | n <- as.integer(nrow(qr@qr)) 49 | p <- as.integer(ncol(qr@qr)) 50 | #k <- as.integer(qr$rank) 51 | ny <- as.integer(ncol(y)) 52 | if(n!=nrow(y)) 53 | stop("Dimension mismatch") 54 | if (p == 0L) 55 | stop("gmatrix in qr has a dimension of 0") 56 | 57 | if (p > n) 58 | stop("Columns of qr matrix must be less than or equal to rows.") 59 | 60 | dummy=.Call("rcusolve_modqr_coef", qr@qr, qr@qraux, y) 61 | 62 | if (p < n) 63 | return(y[1:p,]) 64 | else 65 | return(y) 66 | } 67 | ) 68 | 69 | setMethod("solve", signature(a = "gmatrix", b = "ANY"), 70 | function (a, b, ...) 71 | { 72 | if(a@type>1L) 73 | type(a)=0L 74 | #if(!missing(b)) 75 | # if(b@type>1L) 76 | # type(b)=type(a) 77 | #browser() 78 | a <- qr(a) 79 | nc <- ncol(a@qr) 80 | #if (a$rank != nc) 81 | # stop("singular matrix 'a' in 'solve'") 82 | if (missing(b)) { 83 | if (nc != nrow(a@qr)) 84 | stop("only square matrices can be inverted") 85 | b <- gident(nc, type=a@qr@type) 86 | colnames(b) <- rownames(a@qr) 87 | } 88 | return(gqr.coef(a, b)) 89 | } 90 | ) 91 | 92 | 93 | setMethod("solve", signature(a = "gqr", b = "ANY"), 94 | function (a, b, ...) 95 | { 96 | nc <- ncol(a@qr) 97 | nr <- nrow(a@qr) 98 | # if (a$rank != min(nc, nr)) 99 | # if (a$rank != nc) 100 | # stop("singular matrix 'a' in 'solve'") 101 | if (missing(b)) { 102 | if (nc != nr) 103 | stop("only square matrices can be inverted") 104 | b <- gident(nc, type=a@qr@type) 105 | colnames(b) <- rownames(a@qr) 106 | } 107 | res <- gqr.coef(a, b) 108 | #res[is.na(res)] <- 0 109 | res 110 | } 111 | ) 112 | setMethod("qr", signature(x = "gmatrix"), 113 | function(x,...) 114 | { 115 | checkDevice(x@device) 116 | if(x@type>1L) 117 | type(x)=0L 118 | checkDevice(x@device) 119 | res=new("gqr", 120 | qr=gdup(x), 121 | qraux=gvector(ncol(x), type=x@type) 122 | ) 123 | 124 | tmp <- .Call("rcusolve_qr", res@qr, res@qraux@ptr) 125 | #res@rank=as.integer(sum(res@qraux/max(res@qraux)>10^-6, retgpu=FALSE)) 126 | #if (!is.null(cn <- colnames(x))) 127 | # colnames(res@qr) <- cn[res@pivot] 128 | if (!is.null(cn <- colnames(x))) 129 | colnames(res@qr) <- cn 130 | if (!is.null(cn <- rownames(x))) 131 | rownames(res@qr) <- cn 132 | return(res) 133 | } 134 | ) 135 | 136 | 137 | setClass("gsvd", 138 | representation( 139 | U="gmatrix", 140 | S = "gvector", 141 | VT = "gmatrix"), 142 | prototype = list( 143 | U=NULL, 144 | S=NULL, 145 | VT=NULL) 146 | ) 147 | 148 | setGeneric("svd", function(x,...) base::svd(x,...)) 149 | setMethod("svd", signature(x = "gmatrix"), 150 | function (x) 151 | { 152 | if(x@type>1L) 153 | type(x)=0L 154 | else 155 | x=gdup(x) 156 | 157 | if(nrow(x)=cols. Try transposing the 'x' matrix first.") 159 | res=new("gsvd", 160 | U=gmatrix(0,nrow=nrow(x), ncol=nrow(x), type=x@type), 161 | VT=gmatrix(0,nrow=ncol(x), ncol=ncol(x), type=x@type), 162 | S=gvector(min(ncol(x),nrow(x)), type=x@type) 163 | ) 164 | tmp <- .Call("rcusolve_svd", x, res@S@ptr,res@U, res@VT) 165 | res 166 | } 167 | ) 168 | 169 | 170 | setMethod("chol", signature(x = "gmatrix"), 171 | function (x, dup=TRUE) 172 | { 173 | if(x@type>1L) { 174 | type(x)=0L 175 | } else { 176 | if(dup) 177 | x=gdup(x) 178 | } 179 | 180 | 181 | 182 | if(nrow(x)!=ncol(x)) 183 | stop("chol on the GPU only works for a matrix rows=cols.") 184 | 185 | tmp <- .Call("rcusolve_chol", x) 186 | return(x) 187 | } 188 | ) 189 | 190 | 191 | -------------------------------------------------------------------------------- /tools/mdate-sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # Get modification time of a file or directory and pretty-print it. 3 | 4 | scriptversion=2007-03-30.02 5 | 6 | # Copyright (C) 1995, 1996, 1997, 2003, 2004, 2005, 2007 Free Software 7 | # Foundation, Inc. 8 | # written by Ulrich Drepper , June 1995 9 | # 10 | # This program is free software; you can redistribute it and/or modify 11 | # it under the terms of the GNU General Public License as published by 12 | # the Free Software Foundation; either version 2, or (at your option) 13 | # any later version. 14 | # 15 | # This program is distributed in the hope that it will be useful, 16 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | # GNU General Public License for more details. 19 | # 20 | # You should have received a copy of the GNU General Public License 21 | # along with this program; if not, write to the Free Software Foundation, 22 | # Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. 23 | 24 | # As a special exception to the GNU General Public License, if you 25 | # distribute this file as part of a program that contains a 26 | # configuration script generated by Autoconf, you may include it under 27 | # the same distribution terms that you use for the rest of that program. 28 | 29 | # This file is maintained in Automake, please report 30 | # bugs to or send patches to 31 | # . 32 | 33 | case $1 in 34 | '') 35 | echo "$0: No file. Try \`$0 --help' for more information." 1>&2 36 | exit 1; 37 | ;; 38 | -h | --h*) 39 | cat <<\EOF 40 | Usage: mdate-sh [--help] [--version] FILE 41 | 42 | Pretty-print the modification time of FILE. 43 | 44 | Report bugs to . 45 | EOF 46 | exit $? 47 | ;; 48 | -v | --v*) 49 | echo "mdate-sh $scriptversion" 50 | exit $? 51 | ;; 52 | esac 53 | 54 | # Prevent date giving response in another language. 55 | LANG=C 56 | export LANG 57 | LC_ALL=C 58 | export LC_ALL 59 | LC_TIME=C 60 | export LC_TIME 61 | 62 | # GNU ls changes its time format in response to the TIME_STYLE 63 | # variable. Since we cannot assume `unset' works, revert this 64 | # variable to its documented default. 65 | if test "${TIME_STYLE+set}" = set; then 66 | TIME_STYLE=posix-long-iso 67 | export TIME_STYLE 68 | fi 69 | 70 | save_arg1=$1 71 | 72 | # Find out how to get the extended ls output of a file or directory. 73 | if ls -L /dev/null 1>/dev/null 2>&1; then 74 | ls_command='ls -L -l -d' 75 | else 76 | ls_command='ls -l -d' 77 | fi 78 | # Avoid user/group names that might have spaces, when possible. 79 | if ls -n /dev/null 1>/dev/null 2>&1; then 80 | ls_command="$ls_command -n" 81 | fi 82 | 83 | # A `ls -l' line looks as follows on OS/2. 84 | # drwxrwx--- 0 Aug 11 2001 foo 85 | # This differs from Unix, which adds ownership information. 86 | # drwxrwx--- 2 root root 4096 Aug 11 2001 foo 87 | # 88 | # To find the date, we split the line on spaces and iterate on words 89 | # until we find a month. This cannot work with files whose owner is a 90 | # user named `Jan', or `Feb', etc. However, it's unlikely that `/' 91 | # will be owned by a user whose name is a month. So we first look at 92 | # the extended ls output of the root directory to decide how many 93 | # words should be skipped to get the date. 94 | 95 | # On HPUX /bin/sh, "set" interprets "-rw-r--r--" as options, so the "x" below. 96 | set x`$ls_command /` 97 | 98 | # Find which argument is the month. 99 | month= 100 | command= 101 | until test $month 102 | do 103 | shift 104 | # Add another shift to the command. 105 | command="$command shift;" 106 | case $1 in 107 | Jan) month=January; nummonth=1;; 108 | Feb) month=February; nummonth=2;; 109 | Mar) month=March; nummonth=3;; 110 | Apr) month=April; nummonth=4;; 111 | May) month=May; nummonth=5;; 112 | Jun) month=June; nummonth=6;; 113 | Jul) month=July; nummonth=7;; 114 | Aug) month=August; nummonth=8;; 115 | Sep) month=September; nummonth=9;; 116 | Oct) month=October; nummonth=10;; 117 | Nov) month=November; nummonth=11;; 118 | Dec) month=December; nummonth=12;; 119 | esac 120 | done 121 | 122 | # Get the extended ls output of the file or directory. 123 | set dummy x`eval "$ls_command \"\$save_arg1\""` 124 | 125 | # Remove all preceding arguments 126 | eval $command 127 | 128 | # Because of the dummy argument above, month is in $2. 129 | # 130 | # On a POSIX system, we should have 131 | # 132 | # $# = 5 133 | # $1 = file size 134 | # $2 = month 135 | # $3 = day 136 | # $4 = year or time 137 | # $5 = filename 138 | # 139 | # On Darwin 7.7.0 and 7.6.0, we have 140 | # 141 | # $# = 4 142 | # $1 = day 143 | # $2 = month 144 | # $3 = year or time 145 | # $4 = filename 146 | 147 | # Get the month. 148 | case $2 in 149 | Jan) month=January; nummonth=1;; 150 | Feb) month=February; nummonth=2;; 151 | Mar) month=March; nummonth=3;; 152 | Apr) month=April; nummonth=4;; 153 | May) month=May; nummonth=5;; 154 | Jun) month=June; nummonth=6;; 155 | Jul) month=July; nummonth=7;; 156 | Aug) month=August; nummonth=8;; 157 | Sep) month=September; nummonth=9;; 158 | Oct) month=October; nummonth=10;; 159 | Nov) month=November; nummonth=11;; 160 | Dec) month=December; nummonth=12;; 161 | esac 162 | 163 | case $3 in 164 | ???*) day=$1;; 165 | *) day=$3; shift;; 166 | esac 167 | 168 | # Here we have to deal with the problem that the ls output gives either 169 | # the time of day or the year. 170 | case $3 in 171 | *:*) set `date`; eval year=\$$# 172 | case $2 in 173 | Jan) nummonthtod=1;; 174 | Feb) nummonthtod=2;; 175 | Mar) nummonthtod=3;; 176 | Apr) nummonthtod=4;; 177 | May) nummonthtod=5;; 178 | Jun) nummonthtod=6;; 179 | Jul) nummonthtod=7;; 180 | Aug) nummonthtod=8;; 181 | Sep) nummonthtod=9;; 182 | Oct) nummonthtod=10;; 183 | Nov) nummonthtod=11;; 184 | Dec) nummonthtod=12;; 185 | esac 186 | # For the first six month of the year the time notation can also 187 | # be used for files modified in the last year. 188 | if (expr $nummonth \> $nummonthtod) > /dev/null; 189 | then 190 | year=`expr $year - 1` 191 | fi;; 192 | *) year=$3;; 193 | esac 194 | 195 | # The result. 196 | echo $day $month $year 197 | 198 | # Local Variables: 199 | # mode: shell-script 200 | # sh-indentation: 2 201 | # eval: (add-hook 'write-file-hooks 'time-stamp) 202 | # time-stamp-start: "scriptversion=" 203 | # time-stamp-format: "%:y-%02m-%02d.%02H" 204 | # time-stamp-end: "$" 205 | # End: 206 | -------------------------------------------------------------------------------- /R/07MCMC.R: -------------------------------------------------------------------------------- 1 | # TODO: Add comment 2 | # 3 | # Author: nmorris 4 | ############################################################################### 5 | # BASIC HAMILTONIAN MONTE CARLO UPDATE 6 | # This HMC implementation has been greatly modified from the one created by Radford M. Neal, 2012. 7 | # but may still bear a vague simularity 8 | 9 | #The copyright for the original code is described bellow: 10 | 11 | #> This directory contains a preliminary version of GRIMS, released 2012-06-07. 12 | #> 13 | #> The contents of this directory are Copyright (c) 2011-2012 by Radford M. Neal. 14 | #> 15 | #> Permission is granted for anyone to copy, use, modify, or distribute these 16 | #> programs and accompanying documents for any purpose, provided this copyright 17 | #> notice is retained and prominently displayed, along with a note saying 18 | #> that the original programs are available from Radford Neal's web page, and 19 | #> note is made of any changes made to these programs. These programs and 20 | #> documents are distributed without any warranty, express or implied. As the 21 | #> programs were written for research purposes only, they have not been tested 22 | #> to the degree that would be advisable in any important application. All use 23 | #> of these programs is entirely at the user's own risk. 24 | #> 25 | #> This software can be obtained from http://www.cs.utoronto.ca/~radford/GRIMS.html 26 | 27 | setClass("lpgr", 28 | representation( 29 | gr="list", 30 | lp = "numeric"), 31 | prototype = list( 32 | gr=NULL, 33 | lp=NULL) 34 | ) 35 | 36 | 37 | 38 | 39 | .basicHMCOneStep <- function (lpgrf, initial, lpgr.initial, nsteps, step, 40 | initial.p = lapply(initial,function(x) gmatrix(grnorm(nrow(x)*ncol(x)), nrow(x),ncol(x), dup=FALSE)), 41 | T=1, errorChecks=TRUE) 42 | { 43 | 44 | if(errorChecks) { 45 | #Check and process the arguments. 46 | if(!("list" %in% class(initial) && "list" %in% class(initial.p))) 47 | stop("initial and initial.p must be lists") 48 | nm1=names(initial) 49 | nm2=names(initial.p) 50 | if(length(nm1)!=length(nm2)) 51 | stop("initial and initial.p do not match.") 52 | if(!all(nm1==nm2)) 53 | stop("initial and initial.p do not match.") 54 | if(!all(sapply(initial, function(x) class(x) %in% c("matrix","gmatrix")))) 55 | stop("All elements of 'initial' must be either of class matrix or 'gmatrix.'") 56 | if(!all(sapply(initial.p, function(x) class(x) %in% c("matrix","gmatrix")))) 57 | stop("All elements of 'initial.p' must be either of class matrix or 'gmatrix.'") 58 | 59 | nparrallel=ncol(initial[[1]]) 60 | if(!all(sapply(initial, ncol)==nparrallel)) 61 | stop("'initial' has non matching number of cols") 62 | if(!all(sapply(initial, ncol)==nparrallel)) 63 | stop("'initial.p' has non matching number of cols.") 64 | 65 | if(!all(sapply(initial, nrow)==sapply(initial.p, nrow))) 66 | stop("'initial.p' vs 'initial' has non matching number of rows") 67 | 68 | nsteps=as.integer(nsteps)[1] 69 | if(length(step)==1){ 70 | step=as.numeric(step) 71 | step=sapply(nm1, function(i) step) 72 | } 73 | nm3=names(step) 74 | if(length(nm1)!=length(nm3)) 75 | stop("initial and step do not match.") 76 | if(!all(nm1==nm3)) 77 | stop("initial and step do not match.") 78 | } 79 | if(missing(lpgr.initial)) 80 | lpgr.initial <- lpgrf(initial) 81 | 82 | if(errorChecks) { 83 | if(!("lpgr" %in% class(lpgr.initial))) { 84 | stop("lpgr.initial not of class 'lpgr.' Please make sure the lpgr function returns an object of the correct class.") 85 | } 86 | if(length(lpgr.initial @lp)!=nparrallel) 87 | stop("The lpgr is not returning the the log probability (lp) for the correct numer of parrallel simulations.") 88 | nm4=names(lpgr.initial@gr) 89 | if(length(nm1)!=length(nm4)) 90 | stop("initial names and lpgr function output (for the 'gr' slot) do not match.") 91 | if(!all(nm1==nm4)) 92 | stop("initial names and lpgr function output (for the 'gr' slot) do not match.") 93 | if(!all(sapply(lpgr.initial@gr, ncol)==nparrallel)) 94 | stop("Number of columns returned by lpgr function in an element of the 'gr' slot is not the parrallel number of simulations.") 95 | } 96 | 97 | # Compute the kinetic energy at the start of the trajectory. 98 | kinetic.initial <- rowSums(sapply(initial.p,function(x) { x=as.matrix(x); colSums(x*x) / 2 })) 99 | 100 | # Compute the trajectory by the leapfrog method. 101 | q <- initial 102 | p <- initial.p 103 | 104 | # Make a half step for momentum at the beginning. 105 | p <- mapply(function(p,gr,step) return(p + (step/2) * gr), p , lpgr.initial@gr, step, SIMPLIFY=FALSE) 106 | 107 | # Alternate full steps for position and momentum. 108 | for (i in 1:nsteps) 109 | { 110 | # Make a full step for the position, and evaluate the gradient at the new 111 | # position. 112 | q <- mapply(function(p,q,step) return( q + step * p), p , q, step, SIMPLIFY = FALSE) #q <- q + step * p 113 | lpgr.current <- lpgrf(q) 114 | if(!("lpgr" %in% class(lpgr.initial))) { 115 | stop("lpgr not of class 'lpgr.'") 116 | } 117 | # Make a full step for the momentum, except when we're coming to the end of 118 | # the trajectory. 119 | if (i!=nsteps) 120 | { #p <- p + step * gr 121 | p=mapply(function(p,gr,step) return(p + (step) * gr), p , lpgr.current@gr, step, SIMPLIFY = FALSE) 122 | } 123 | } 124 | 125 | # Make a half step for momentum at the end. 126 | #p <- p + (step/2) * gr 127 | p <- mapply(function(p,gr,step) return(p + (step/2) * gr), p , lpgr.current@gr, step, SIMPLIFY = FALSE) 128 | 129 | 130 | # Look at log probability and kinetic energy at the end of the trajectory. 131 | #lpgr.prop <- lpgr.current$ll 132 | #kinetic.prop <- sum(p^2) / 2 133 | kinetic.prop <- rowSums(sapply(p,function(x) { x=as.matrix(x); colSums(x*x) / 2 })) 134 | 135 | # Accept or reject the state at the end of the trajectory. 136 | H.initial <- -as.numeric(lpgr.initial@lp) + kinetic.initial 137 | H.prop <- -as.numeric( lpgr.current@lp )+ kinetic.prop 138 | delta <- H.prop - H.initial 139 | apr <- pmin(1,exp(-delta/T)) 140 | acc <- runif(nparrallel) < apr 141 | notacc=which(!acc) 142 | 143 | moveBack=function(propl,oldl) { 144 | mapply(function(prop,old) { 145 | prop[,notacc]=old[, notacc] 146 | return(prop)}, 147 | propl,oldl,SIMPLIFY = FALSE) 148 | } 149 | if(length(notacc) > 0) { 150 | q=moveBack(q, initial) 151 | lpgr.current@gr=moveBack(lpgr.current@gr, lpgr.initial@gr) 152 | lpgr.current@lp[notacc] = lpgr.initial@lp[notacc] 153 | } 154 | return(list (acc=acc, q.current=q, lpgr.current=lpgr.current)) 155 | } 156 | 157 | .simp=function(lst) { 158 | return(lapply(lst, function(x) 159 | if("gmatrix" %in% class(x)) 160 | return(gmatrix(grnorm(nrow(x)*ncol(x)), nrow(x),ncol(x), dup=FALSE)) 161 | else 162 | return(matrix(rnorm(nrow(x)*ncol(x)), nrow(x),ncol(x))) 163 | )) 164 | } 165 | 166 | keep=function(q) lapply(q, function(x) if(any(class(x) %in% c("gmatrix","gvector"))) h(x) else x) 167 | 168 | gBasicHMC = function (lpgrf, initial, nsims, nsteps, step, 169 | burnin=1, nstepsburnin=nsteps,stepburnin=step, Tstart=1, r=1 , 170 | keep=keep, 171 | thin=1, report=100){ 172 | 173 | sims=list() 174 | lp=list() 175 | st=list(q.current=initial, lpgr.current=lpgrf(initial)) 176 | psims=length(st$lpgr.current@lp) 177 | accBurninSum=numeric(psims) 178 | accSimsSum=numeric(psims) 179 | accBurninDenom=0 180 | accSimsDenom=0 181 | 182 | curnsteps=nstepsburnin 183 | curstep=stepburnin 184 | T=Tstart 185 | for(i in 1:nsims) { 186 | initial.p = .simp(st$q.current) 187 | st=.basicHMCOneStep(lpgrf, 188 | initial=st$q.current, 189 | initial.p=initial.p, 190 | lpgr.initial=st$lpgr.current, 191 | nsteps=curnsteps, step=curstep, T=T) 192 | lp[[i]]=st$lpgr.current@lp 193 | if(i2^20) 162 | stop("Please make 'total_states' smaller.") 163 | state=as.integer(state) 164 | tmp=.Call("setup_curand", as.integer(total_states), as.integer(state), as.logical(silent), as.logical(TRUE)) 165 | invisible(tmp) 166 | } 167 | #.resetDevice = function() { 168 | # warning("Any prviously created GPU variables will now be removed from the GPU. 169 | # Referencing such variables will have undesired consequences.") 170 | # temp = .C("stopCublas")#will result in fatal error if cublas not started 171 | # temp = .C("free_dev_states") 172 | # temp = .C("deviceReset") 173 | # .startDevice() 174 | #} 175 | 176 | ggc=function(silent=FALSE) { 177 | gc(verbose =FALSE) 178 | free=integer(1) 179 | tot=integer(1) 180 | tmp = .C("check_mem",free,tot,as.logical(silent)) 181 | } 182 | 183 | 184 | .gpu_get =function(ptr, ln, tp) { 185 | if(tp==1L) { #float must be converted first 186 | ptr=.Call("gpu_convert", ptr,ln, 1L, 0L ) 187 | tp=0L 188 | } 189 | if(ln==0L) { 190 | if(tp==0 || tp==1) 191 | return(numeric(0)) 192 | else if(tp==3) 193 | return(integer(0)) 194 | else 195 | return(logical(0)) 196 | } 197 | 198 | ret=.Call("gpu_get", ptr, ln, tp) 199 | return(ret) 200 | } 201 | 202 | 203 | 204 | .type_num = function(type) { 205 | type=type[1] 206 | if(is.integer(type)) { 207 | if(type<4) 208 | return(type) 209 | else 210 | stop(paste("Invalid Type:", type),call. = FALSE) 211 | } else if(!is.character(type)) 212 | stop("Invalid Type") 213 | else if(type=="d") 214 | return(0L) 215 | else if(type=="s") 216 | return(1L) 217 | else if(type=="i") 218 | return(2L) 219 | else if(type=="l") 220 | return(3L) 221 | else if(type=="double") 222 | return(0L) 223 | else if(type=="single") 224 | return(1L) 225 | else if(type=="integer") 226 | return(2L) 227 | else if(type=="logical") 228 | return(3L) 229 | else 230 | stop(paste("Invalid Type:", type),call. = FALSE) 231 | } 232 | 233 | .type_name= function(type) { 234 | if(type==0L) 235 | return("double") 236 | else if(type==1L) 237 | return("single") 238 | else if(type==2L) 239 | return("integer") 240 | else if(type==3L) 241 | return("logical") 242 | else 243 | stop("Invalid Type") 244 | } 245 | 246 | 247 | .Rclass_to_type=function(x) { 248 | if(is.integer(x)) 249 | return(2L) 250 | else if(is.numeric(x)) 251 | return(0L) 252 | else if(is.logical(x)) 253 | return(3L) 254 | else 255 | stop(paste("Unknown class:",class(x))) 256 | } 257 | 258 | 259 | 260 | 261 | .Rclass_to_type_int=function(x) { 262 | tmp=as.integer(x) 263 | if( as.integer(x)==x) 264 | return(2L) 265 | else if(is.numeric(x)) 266 | return(0L) 267 | else if(is.logical(x)) 268 | return(2L) 269 | else 270 | stop(paste("Unknown class:",class(x)),call. = FALSE) 271 | } 272 | 273 | 274 | .convert_to_appropriate_class = function(x,type) { 275 | if(type==0L) { 276 | x=as.double(x) 277 | } else if(type==1L){ 278 | x=as.double(x) 279 | } else if(type==2L){ 280 | x=as.integer(x) 281 | } else if(type==3L){ 282 | x=as.logical(x) 283 | } else 284 | stop("Invalid type") 285 | return(x) 286 | } 287 | 288 | 289 | 290 | #.check_input = function(IN1, IN2, IN3, allowed="DSIL") {#allowed is the types allowes D=doulbe, S=single, I=integer, L=logicla 291 | # if(is.missing(IN2)) 292 | # stop("IN1 is missing") 293 | # if(allowed=="SFIL") { 294 | # if(is.missing(IN2)) 295 | # return(TRUE) 296 | # else { 297 | # if(IN1@type!=IN2@type) { 298 | # stop("") 299 | # } 300 | # } 301 | # 302 | # } 303 | # 304 | #} 305 | 306 | convertType= function(x, to, dup=TRUE) { 307 | if(!(class(x) %in% c("gmatrix", "gvector"))) 308 | stop("x is not a gpu object, so it's type cannot be converted") 309 | #cat(x@device, x@type, class(x),"\n") 310 | #print(x) 311 | checkDevice(x@device) 312 | totype=.type_num(to) 313 | fromtype=x@type 314 | if(fromtype!=totype) { 315 | if(totype==3L) { 316 | return(x!=0L) 317 | } else if(totype==2L && fromtype==3L){ #logical and int both stored as integers 318 | x@type=2L 319 | return(x) 320 | } else { 321 | ret=x 322 | ret@ptr=.Call("gpu_convert", x@ptr, length(x), fromtype, totype ) 323 | ret@type=totype 324 | return(ret) 325 | } 326 | } else { 327 | if(dup) 328 | return(gdup(x)) 329 | else 330 | return(x) 331 | } 332 | } 333 | 334 | 335 | 336 | 337 | g = function(x, type=NULL, dup=TRUE) { 338 | if(is.matrix(x)) 339 | return(as.gmatrix(x,type=type,dup=dup)) 340 | if(is.vector(x)) 341 | return(as.gvector(x,type=type,dup=dup)) 342 | stop("Input to 'g()' is allready a gpu object, or cannot be converted to a gpu object.") 343 | } 344 | 345 | h = function(x) { 346 | if(class(x)=="gmatrix") 347 | return(as.matrix(x)) 348 | if(class(x)=="gvector") { 349 | ret=(as.vector(x)) 350 | #if(!gnamestrip && length(names(x))>0) 351 | names(ret)=names(x) 352 | return(ret) 353 | } 354 | stop("Input to 'h' is not a gpu object.") 355 | } 356 | 357 | 358 | 359 | 360 | 361 | gdup=function(x, dev=getDevice()) { 362 | if(!(class(x) %in% c("gmatrix","gvector"))) 363 | stop("not a gpu object.") 364 | if(x@device==dev) { 365 | oldDevice=getDevice() 366 | if(x@device!=oldDevice) { 367 | setDevice(x@device, silent=TRUE) 368 | } 369 | #checkDevice(x@device) 370 | mylength=length(x) 371 | ret=x 372 | ret@ptr=.Call("gpu_duplicate", x@ptr, mylength, x@type) 373 | if(x@device!=oldDevice) { 374 | setDevice(oldDevice, silent=TRUE) 375 | } 376 | return(ret) 377 | } else { 378 | ret=x 379 | device(ret)=dev 380 | return(ret) 381 | } 382 | } 383 | 384 | gnamestrip=function(x,dup=TRUE) { 385 | if(class(x) =="gvector") 386 | names(x)=NULL 387 | else if(class(x)=="gmatrix"){ 388 | rownames(x)=NULL 389 | colnames(x)=NULL 390 | } else 391 | stop("not a gpu object.") 392 | if(dup) 393 | x=gdup(x) 394 | return(x) 395 | } 396 | -------------------------------------------------------------------------------- /man/BinaryOperators-methods.Rd: -------------------------------------------------------------------------------- 1 | \name{elementwise binary operators} 2 | \docType{methods} 3 | 4 | \alias{*-methods} 5 | \alias{*,gmatrix,gmatrix-method} 6 | \alias{*,gmatrix,gvector-method} 7 | \alias{*,gmatrix,logical-method} 8 | \alias{*,gmatrix,matrix-method} 9 | \alias{*,gmatrix,numeric-method} 10 | \alias{*,gvector,gmatrix-method} 11 | \alias{*,gvector,gvector-method} 12 | \alias{*,gvector,logical-method} 13 | \alias{*,gvector,matrix-method} 14 | \alias{*,gvector,numeric-method} 15 | \alias{*,logical,gmatrix-method} 16 | \alias{*,logical,gvector-method} 17 | \alias{*,matrix,gmatrix-method} 18 | \alias{*,matrix,gvector-method} 19 | \alias{*,numeric,gmatrix-method} 20 | \alias{*,numeric,gvector-method} 21 | 22 | \alias{+-methods} 23 | \alias{+,gmatrix,gmatrix-method} 24 | \alias{+,gmatrix,gvector-method} 25 | \alias{+,gmatrix,logical-method} 26 | \alias{+,gmatrix,matrix-method} 27 | \alias{+,gmatrix,missing-method} 28 | \alias{+,gmatrix,numeric-method} 29 | \alias{+,gvector,gmatrix-method} 30 | \alias{+,gvector,gvector-method} 31 | \alias{+,gvector,logical-method} 32 | \alias{+,gvector,matrix-method} 33 | \alias{+,gvector,missing-method} 34 | \alias{+,gvector,numeric-method} 35 | \alias{+,logical,gmatrix-method} 36 | \alias{+,logical,gvector-method} 37 | \alias{+,matrix,gmatrix-method} 38 | \alias{+,matrix,gvector-method} 39 | \alias{+,numeric,gmatrix-method} 40 | \alias{+,numeric,gvector-method} 41 | 42 | \alias{--methods} 43 | \alias{-,gmatrix,gmatrix-method} 44 | \alias{-,gmatrix,gvector-method} 45 | \alias{-,gmatrix,logical-method} 46 | \alias{-,gmatrix,matrix-method} 47 | \alias{-,gmatrix,missing-method} 48 | \alias{-,gmatrix,numeric-method} 49 | \alias{-,gvector,gmatrix-method} 50 | \alias{-,gvector,gvector-method} 51 | \alias{-,gvector,logical-method} 52 | \alias{-,gvector,matrix-method} 53 | \alias{-,gvector,missing-method} 54 | \alias{-,gvector,numeric-method} 55 | \alias{-,logical,gmatrix-method} 56 | \alias{-,logical,gvector-method} 57 | \alias{-,matrix,gmatrix-method} 58 | \alias{-,matrix,gvector-method} 59 | \alias{-,numeric,gmatrix-method} 60 | \alias{-,numeric,gvector-method} 61 | 62 | \alias{/-methods} 63 | \alias{/,gmatrix,gmatrix-method} 64 | \alias{/,gmatrix,gvector-method} 65 | \alias{/,gmatrix,logical-method} 66 | \alias{/,gmatrix,matrix-method} 67 | \alias{/,gmatrix,numeric-method} 68 | \alias{/,gvector,gmatrix-method} 69 | \alias{/,gvector,gvector-method} 70 | \alias{/,gvector,logical-method} 71 | \alias{/,gvector,matrix-method} 72 | \alias{/,gvector,numeric-method} 73 | \alias{/,logical,gmatrix-method} 74 | \alias{/,logical,gvector-method} 75 | \alias{/,matrix,gmatrix-method} 76 | \alias{/,matrix,gvector-method} 77 | \alias{/,numeric,gmatrix-method} 78 | \alias{/,numeric,gvector-method} 79 | 80 | \alias{^-methods} 81 | \alias{^,gmatrix,gmatrix-method} 82 | \alias{^,gmatrix,gvector-method} 83 | \alias{^,gmatrix,logical-method} 84 | \alias{^,gmatrix,matrix-method} 85 | \alias{^,gmatrix,numeric-method} 86 | \alias{^,gvector,gmatrix-method} 87 | \alias{^,gvector,gvector-method} 88 | \alias{^,gvector,logical-method} 89 | \alias{^,gvector,matrix-method} 90 | \alias{^,gvector,numeric-method} 91 | \alias{^,logical,gmatrix-method} 92 | \alias{^,logical,gvector-method} 93 | \alias{^,matrix,gmatrix-method} 94 | \alias{^,matrix,gvector-method} 95 | \alias{^,numeric,gmatrix-method} 96 | \alias{^,numeric,gvector-method} 97 | 98 | \alias{\%\%-methods} 99 | \alias{\%\%,gmatrix,gmatrix-method} 100 | \alias{\%\%,gmatrix,gvector-method} 101 | \alias{\%\%,gmatrix,logical-method} 102 | \alias{\%\%,gmatrix,matrix-method} 103 | \alias{\%\%,gmatrix,numeric-method} 104 | \alias{\%\%,gvector,gmatrix-method} 105 | \alias{\%\%,gvector,gvector-method} 106 | \alias{\%\%,gvector,logical-method} 107 | \alias{\%\%,gvector,matrix-method} 108 | \alias{\%\%,gvector,numeric-method} 109 | \alias{\%\%,logical,gmatrix-method} 110 | \alias{\%\%,logical,gvector-method} 111 | \alias{\%\%,matrix,gmatrix-method} 112 | \alias{\%\%,matrix,gvector-method} 113 | \alias{\%\%,numeric,gmatrix-method} 114 | \alias{\%\%,numeric,gvector-method} 115 | 116 | \alias{==-methods} 117 | \alias{==,gmatrix,gmatrix-method} 118 | \alias{==,gmatrix,gvector-method} 119 | \alias{==,gmatrix,logical-method} 120 | \alias{==,gmatrix,matrix-method} 121 | \alias{==,gmatrix,numeric-method} 122 | \alias{==,gvector,gmatrix-method} 123 | \alias{==,gvector,gvector-method} 124 | \alias{==,gvector,logical-method} 125 | \alias{==,gvector,matrix-method} 126 | \alias{==,gvector,numeric-method} 127 | \alias{==,logical,gmatrix-method} 128 | \alias{==,logical,gvector-method} 129 | \alias{==,matrix,gmatrix-method} 130 | \alias{==,matrix,gvector-method} 131 | \alias{==,numeric,gmatrix-method} 132 | \alias{==,numeric,gvector-method} 133 | 134 | \alias{>-methods} 135 | \alias{>,gmatrix,gmatrix-method} 136 | \alias{>,gmatrix,gvector-method} 137 | \alias{>,gmatrix,logical-method} 138 | \alias{>,gmatrix,matrix-method} 139 | \alias{>,gmatrix,numeric-method} 140 | \alias{>,gvector,gmatrix-method} 141 | \alias{>,gvector,gvector-method} 142 | \alias{>,gvector,logical-method} 143 | \alias{>,gvector,matrix-method} 144 | \alias{>,gvector,numeric-method} 145 | \alias{>,logical,gmatrix-method} 146 | \alias{>,logical,gvector-method} 147 | \alias{>,matrix,gmatrix-method} 148 | \alias{>,matrix,gvector-method} 149 | \alias{>,numeric,gmatrix-method} 150 | \alias{>,numeric,gvector-method} 151 | 152 | %\alias{<-methods} 153 | \alias{<,gmatrix,gmatrix-method} 154 | \alias{<,gmatrix,gvector-method} 155 | \alias{<,gmatrix,logical-method} 156 | \alias{<,gmatrix,matrix-method} 157 | \alias{<,gmatrix,numeric-method} 158 | \alias{<,gvector,gmatrix-method} 159 | \alias{<,gvector,gvector-method} 160 | \alias{<,gvector,logical-method} 161 | \alias{<,gvector,matrix-method} 162 | \alias{<,gvector,numeric-method} 163 | \alias{<,logical,gmatrix-method} 164 | \alias{<,logical,gvector-method} 165 | \alias{<,matrix,gmatrix-method} 166 | \alias{<,matrix,gvector-method} 167 | \alias{<,numeric,gmatrix-method} 168 | \alias{<,numeric,gvector-method} 169 | 170 | \alias{>=-methods} 171 | \alias{>=,gmatrix,gmatrix-method} 172 | \alias{>=,gmatrix,gvector-method} 173 | \alias{>=,gmatrix,logical-method} 174 | \alias{>=,gmatrix,matrix-method} 175 | \alias{>=,gmatrix,numeric-method} 176 | \alias{>=,gvector,gmatrix-method} 177 | \alias{>=,gvector,gvector-method} 178 | \alias{>=,gvector,logical-method} 179 | \alias{>=,gvector,matrix-method} 180 | \alias{>=,gvector,numeric-method} 181 | \alias{>=,logical,gmatrix-method} 182 | \alias{>=,logical,gvector-method} 183 | \alias{>=,matrix,gmatrix-method} 184 | \alias{>=,matrix,gvector-method} 185 | \alias{>=,numeric,gmatrix-method} 186 | \alias{>=,numeric,gvector-method} 187 | 188 | \alias{<=-methods} 189 | \alias{<=,gmatrix,gmatrix-method} 190 | \alias{<=,gmatrix,gvector-method} 191 | \alias{<=,gmatrix,logical-method} 192 | \alias{<=,gmatrix,matrix-method} 193 | \alias{<=,gmatrix,numeric-method} 194 | \alias{<=,gvector,gmatrix-method} 195 | \alias{<=,gvector,gvector-method} 196 | \alias{<=,gvector,logical-method} 197 | \alias{<=,gvector,matrix-method} 198 | \alias{<=,gvector,numeric-method} 199 | \alias{<=,logical,gmatrix-method} 200 | \alias{<=,logical,gvector-method} 201 | \alias{<=,matrix,gmatrix-method} 202 | \alias{<=,matrix,gvector-method} 203 | \alias{<=,numeric,gmatrix-method} 204 | \alias{<=,numeric,gvector-method} 205 | 206 | \alias{!=-methods} 207 | \alias{!=,gmatrix,gmatrix-method} 208 | \alias{!=,gmatrix,gvector-method} 209 | \alias{!=,gmatrix,logical-method} 210 | \alias{!=,gmatrix,matrix-method} 211 | \alias{!=,gmatrix,numeric-method} 212 | \alias{!=,gvector,gmatrix-method} 213 | \alias{!=,gvector,gvector-method} 214 | \alias{!=,gvector,logical-method} 215 | \alias{!=,gvector,matrix-method} 216 | \alias{!=,gvector,numeric-method} 217 | \alias{!=,logical,gmatrix-method} 218 | \alias{!=,logical,gvector-method} 219 | \alias{!=,matrix,gmatrix-method} 220 | \alias{!=,matrix,gvector-method} 221 | \alias{!=,numeric,gmatrix-method} 222 | \alias{!=,numeric,gvector-method} 223 | 224 | \alias{&-methods} 225 | \alias{&,gmatrix,gmatrix-method} 226 | \alias{&,gmatrix,gvector-method} 227 | \alias{&,gmatrix,logical-method} 228 | \alias{&,gmatrix,matrix-method} 229 | \alias{&,gmatrix,numeric-method} 230 | \alias{&,gvector,gmatrix-method} 231 | \alias{&,gvector,gvector-method} 232 | \alias{&,gvector,logical-method} 233 | \alias{&,gvector,matrix-method} 234 | \alias{&,gvector,numeric-method} 235 | \alias{&,logical,gmatrix-method} 236 | \alias{&,logical,gvector-method} 237 | \alias{&,matrix,gmatrix-method} 238 | \alias{&,matrix,gvector-method} 239 | \alias{&,numeric,gmatrix-method} 240 | \alias{&,numeric,gvector-method} 241 | 242 | \alias{|-methods} 243 | \alias{|,gmatrix,gmatrix-method} 244 | \alias{|,gmatrix,gvector-method} 245 | \alias{|,gmatrix,logical-method} 246 | \alias{|,gmatrix,matrix-method} 247 | \alias{|,gmatrix,numeric-method} 248 | \alias{|,gvector,gmatrix-method} 249 | \alias{|,gvector,gvector-method} 250 | \alias{|,gvector,logical-method} 251 | \alias{|,gvector,matrix-method} 252 | \alias{|,gvector,numeric-method} 253 | \alias{|,logical,gmatrix-method} 254 | \alias{|,logical,gvector-method} 255 | \alias{|,matrix,gmatrix-method} 256 | \alias{|,matrix,gvector-method} 257 | \alias{|,numeric,gmatrix-method} 258 | \alias{|,numeric,gvector-method} 259 | 260 | \alias{\%lgspadd\%} 261 | \alias{\%lgspadd\%-methods} 262 | \alias{\%lgspadd\%,gmatrix,gmatrix-method} 263 | \alias{\%lgspadd\%,gmatrix,gvector-method} 264 | \alias{\%lgspadd\%,gmatrix,logical-method} 265 | \alias{\%lgspadd\%,gmatrix,matrix-method} 266 | \alias{\%lgspadd\%,gmatrix,numeric-method} 267 | \alias{\%lgspadd\%,gvector,gmatrix-method} 268 | \alias{\%lgspadd\%,gvector,gvector-method} 269 | \alias{\%lgspadd\%,gvector,logical-method} 270 | \alias{\%lgspadd\%,gvector,matrix-method} 271 | \alias{\%lgspadd\%,gvector,numeric-method} 272 | \alias{\%lgspadd\%,logical,gmatrix-method} 273 | \alias{\%lgspadd\%,logical,gvector-method} 274 | \alias{\%lgspadd\%,matrix,gmatrix-method} 275 | \alias{\%lgspadd\%,matrix,gvector-method} 276 | \alias{\%lgspadd\%,numeric,gmatrix-method} 277 | \alias{\%lgspadd\%,numeric,gvector-method} 278 | 279 | \title{Binary Operators} 280 | \description{ 281 | This page documents the operators \code{"*"}, \code{"+"}, \code{"-"}, \code{"/"}, \code{"^"}, \code{"\%\%"}, 282 | \code{"="}, \code{"<"}, \code{">"}, \code{">="}, \code{"<="}, \code{"!="}, \code{"&"} and \code{"|"}. 283 | These are all element-wise binary operations that can be performed on a \code{gmatrix} or \code{gvector} object. 284 | Operators work in much that same way as in R base. The command \code{e1 \%lgspadd\% e2} yields the vector 285 | log(exp(e1)+exp(e2)) calculated in a numericaly stable way. 286 | If one object is shorter than the other, items in the shorter object are recycled as in R base. All operations 287 | return a GPU object (i.e. a \code{gmatrix} or \code{gvector}). 288 | } 289 | \section{Methods}{ 290 | \describe{ 291 | \item{\code{signature(e1 = "gmatrix", e2 = "gmatrix")}}{} 292 | \item{\code{signature(e1 = "gmatrix", e2 = "gvector")}}{} 293 | \item{\code{signature(e1 = "gmatrix", e2 = "logical")}}{} 294 | \item{\code{signature(e1 = "gmatrix", e2 = "matrix")}}{} 295 | \item{\code{signature(e1 = "gmatrix", e2 = "numeric")}}{} 296 | \item{\code{signature(e1 = "gvector", e2 = "gmatrix")}}{} 297 | \item{\code{signature(e1 = "gvector", e2 = "gvector")}}{} 298 | \item{\code{signature(e1 = "gvector", e2 = "logical")}}{} 299 | \item{\code{signature(e1 = "gvector", e2 = "matrix")}}{} 300 | \item{\code{signature(e1 = "gvector", e2 = "numeric")}}{} 301 | \item{\code{signature(e1 = "logical", e2 = "gmatrix")}}{} 302 | \item{\code{signature(e1 = "logical", e2 = "gvector")}}{} 303 | \item{\code{signature(e1 = "matrix", e2 = "gmatrix")}}{} 304 | \item{\code{signature(e1 = "matrix", e2 = "gvector")}}{} 305 | \item{\code{signature(e1 = "numeric", e2 = "gmatrix")}}{} 306 | \item{\code{signature(e1 = "numeric", e2 = "gvector")}}{} 307 | }} 308 | \keyword{methods} 309 | \section{Warning }{ 310 | The operator \%\% is known to be numericaly instable compared to the R version. 311 | } 312 | -------------------------------------------------------------------------------- /tools/missing: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | # Common stub for a few missing GNU programs while installing. 3 | 4 | scriptversion=2006-05-10.23 5 | 6 | # Copyright (C) 1996, 1997, 1999, 2000, 2002, 2003, 2004, 2005, 2006 7 | # Free Software Foundation, Inc. 8 | # Originally by Fran,cois Pinard , 1996. 9 | 10 | # This program is free software; you can redistribute it and/or modify 11 | # it under the terms of the GNU General Public License as published by 12 | # the Free Software Foundation; either version 2, or (at your option) 13 | # any later version. 14 | 15 | # This program is distributed in the hope that it will be useful, 16 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | # GNU General Public License for more details. 19 | 20 | # You should have received a copy of the GNU General Public License 21 | # along with this program; if not, write to the Free Software 22 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 23 | # 02110-1301, USA. 24 | 25 | # As a special exception to the GNU General Public License, if you 26 | # distribute this file as part of a program that contains a 27 | # configuration script generated by Autoconf, you may include it under 28 | # the same distribution terms that you use for the rest of that program. 29 | 30 | if test $# -eq 0; then 31 | echo 1>&2 "Try \`$0 --help' for more information" 32 | exit 1 33 | fi 34 | 35 | run=: 36 | sed_output='s/.* --output[ =]\([^ ]*\).*/\1/p' 37 | sed_minuso='s/.* -o \([^ ]*\).*/\1/p' 38 | 39 | # In the cases where this matters, `missing' is being run in the 40 | # srcdir already. 41 | if test -f configure.ac; then 42 | configure_ac=configure.ac 43 | else 44 | configure_ac=configure.in 45 | fi 46 | 47 | msg="missing on your system" 48 | 49 | case $1 in 50 | --run) 51 | # Try to run requested program, and just exit if it succeeds. 52 | run= 53 | shift 54 | "$@" && exit 0 55 | # Exit code 63 means version mismatch. This often happens 56 | # when the user try to use an ancient version of a tool on 57 | # a file that requires a minimum version. In this case we 58 | # we should proceed has if the program had been absent, or 59 | # if --run hadn't been passed. 60 | if test $? = 63; then 61 | run=: 62 | msg="probably too old" 63 | fi 64 | ;; 65 | 66 | -h|--h|--he|--hel|--help) 67 | echo "\ 68 | $0 [OPTION]... PROGRAM [ARGUMENT]... 69 | 70 | Handle \`PROGRAM [ARGUMENT]...' for when PROGRAM is missing, or return an 71 | error status if there is no known handling for PROGRAM. 72 | 73 | Options: 74 | -h, --help display this help and exit 75 | -v, --version output version information and exit 76 | --run try to run the given command, and emulate it if it fails 77 | 78 | Supported PROGRAM values: 79 | aclocal touch file \`aclocal.m4' 80 | autoconf touch file \`configure' 81 | autoheader touch file \`config.h.in' 82 | autom4te touch the output file, or create a stub one 83 | automake touch all \`Makefile.in' files 84 | bison create \`y.tab.[ch]', if possible, from existing .[ch] 85 | flex create \`lex.yy.c', if possible, from existing .c 86 | help2man touch the output file 87 | lex create \`lex.yy.c', if possible, from existing .c 88 | makeinfo touch the output file 89 | tar try tar, gnutar, gtar, then tar without non-portable flags 90 | yacc create \`y.tab.[ch]', if possible, from existing .[ch] 91 | 92 | Send bug reports to ." 93 | exit $? 94 | ;; 95 | 96 | -v|--v|--ve|--ver|--vers|--versi|--versio|--version) 97 | echo "missing $scriptversion (GNU Automake)" 98 | exit $? 99 | ;; 100 | 101 | -*) 102 | echo 1>&2 "$0: Unknown \`$1' option" 103 | echo 1>&2 "Try \`$0 --help' for more information" 104 | exit 1 105 | ;; 106 | 107 | esac 108 | 109 | # Now exit if we have it, but it failed. Also exit now if we 110 | # don't have it and --version was passed (most likely to detect 111 | # the program). 112 | case $1 in 113 | lex|yacc) 114 | # Not GNU programs, they don't have --version. 115 | ;; 116 | 117 | tar) 118 | if test -n "$run"; then 119 | echo 1>&2 "ERROR: \`tar' requires --run" 120 | exit 1 121 | elif test "x$2" = "x--version" || test "x$2" = "x--help"; then 122 | exit 1 123 | fi 124 | ;; 125 | 126 | *) 127 | if test -z "$run" && ($1 --version) > /dev/null 2>&1; then 128 | # We have it, but it failed. 129 | exit 1 130 | elif test "x$2" = "x--version" || test "x$2" = "x--help"; then 131 | # Could not run --version or --help. This is probably someone 132 | # running `$TOOL --version' or `$TOOL --help' to check whether 133 | # $TOOL exists and not knowing $TOOL uses missing. 134 | exit 1 135 | fi 136 | ;; 137 | esac 138 | 139 | # If it does not exist, or fails to run (possibly an outdated version), 140 | # try to emulate it. 141 | case $1 in 142 | aclocal*) 143 | echo 1>&2 "\ 144 | WARNING: \`$1' is $msg. You should only need it if 145 | you modified \`acinclude.m4' or \`${configure_ac}'. You might want 146 | to install the \`Automake' and \`Perl' packages. Grab them from 147 | any GNU archive site." 148 | touch aclocal.m4 149 | ;; 150 | 151 | autoconf) 152 | echo 1>&2 "\ 153 | WARNING: \`$1' is $msg. You should only need it if 154 | you modified \`${configure_ac}'. You might want to install the 155 | \`Autoconf' and \`GNU m4' packages. Grab them from any GNU 156 | archive site." 157 | touch configure 158 | ;; 159 | 160 | autoheader) 161 | echo 1>&2 "\ 162 | WARNING: \`$1' is $msg. You should only need it if 163 | you modified \`acconfig.h' or \`${configure_ac}'. You might want 164 | to install the \`Autoconf' and \`GNU m4' packages. Grab them 165 | from any GNU archive site." 166 | files=`sed -n 's/^[ ]*A[CM]_CONFIG_HEADER(\([^)]*\)).*/\1/p' ${configure_ac}` 167 | test -z "$files" && files="config.h" 168 | touch_files= 169 | for f in $files; do 170 | case $f in 171 | *:*) touch_files="$touch_files "`echo "$f" | 172 | sed -e 's/^[^:]*://' -e 's/:.*//'`;; 173 | *) touch_files="$touch_files $f.in";; 174 | esac 175 | done 176 | touch $touch_files 177 | ;; 178 | 179 | automake*) 180 | echo 1>&2 "\ 181 | WARNING: \`$1' is $msg. You should only need it if 182 | you modified \`Makefile.am', \`acinclude.m4' or \`${configure_ac}'. 183 | You might want to install the \`Automake' and \`Perl' packages. 184 | Grab them from any GNU archive site." 185 | find . -type f -name Makefile.am -print | 186 | sed 's/\.am$/.in/' | 187 | while read f; do touch "$f"; done 188 | ;; 189 | 190 | autom4te) 191 | echo 1>&2 "\ 192 | WARNING: \`$1' is needed, but is $msg. 193 | You might have modified some files without having the 194 | proper tools for further handling them. 195 | You can get \`$1' as part of \`Autoconf' from any GNU 196 | archive site." 197 | 198 | file=`echo "$*" | sed -n "$sed_output"` 199 | test -z "$file" && file=`echo "$*" | sed -n "$sed_minuso"` 200 | if test -f "$file"; then 201 | touch $file 202 | else 203 | test -z "$file" || exec >$file 204 | echo "#! /bin/sh" 205 | echo "# Created by GNU Automake missing as a replacement of" 206 | echo "# $ $@" 207 | echo "exit 0" 208 | chmod +x $file 209 | exit 1 210 | fi 211 | ;; 212 | 213 | bison|yacc) 214 | echo 1>&2 "\ 215 | WARNING: \`$1' $msg. You should only need it if 216 | you modified a \`.y' file. You may need the \`Bison' package 217 | in order for those modifications to take effect. You can get 218 | \`Bison' from any GNU archive site." 219 | rm -f y.tab.c y.tab.h 220 | if test $# -ne 1; then 221 | eval LASTARG="\${$#}" 222 | case $LASTARG in 223 | *.y) 224 | SRCFILE=`echo "$LASTARG" | sed 's/y$/c/'` 225 | if test -f "$SRCFILE"; then 226 | cp "$SRCFILE" y.tab.c 227 | fi 228 | SRCFILE=`echo "$LASTARG" | sed 's/y$/h/'` 229 | if test -f "$SRCFILE"; then 230 | cp "$SRCFILE" y.tab.h 231 | fi 232 | ;; 233 | esac 234 | fi 235 | if test ! -f y.tab.h; then 236 | echo >y.tab.h 237 | fi 238 | if test ! -f y.tab.c; then 239 | echo 'main() { return 0; }' >y.tab.c 240 | fi 241 | ;; 242 | 243 | lex|flex) 244 | echo 1>&2 "\ 245 | WARNING: \`$1' is $msg. You should only need it if 246 | you modified a \`.l' file. You may need the \`Flex' package 247 | in order for those modifications to take effect. You can get 248 | \`Flex' from any GNU archive site." 249 | rm -f lex.yy.c 250 | if test $# -ne 1; then 251 | eval LASTARG="\${$#}" 252 | case $LASTARG in 253 | *.l) 254 | SRCFILE=`echo "$LASTARG" | sed 's/l$/c/'` 255 | if test -f "$SRCFILE"; then 256 | cp "$SRCFILE" lex.yy.c 257 | fi 258 | ;; 259 | esac 260 | fi 261 | if test ! -f lex.yy.c; then 262 | echo 'main() { return 0; }' >lex.yy.c 263 | fi 264 | ;; 265 | 266 | help2man) 267 | echo 1>&2 "\ 268 | WARNING: \`$1' is $msg. You should only need it if 269 | you modified a dependency of a manual page. You may need the 270 | \`Help2man' package in order for those modifications to take 271 | effect. You can get \`Help2man' from any GNU archive site." 272 | 273 | file=`echo "$*" | sed -n "$sed_output"` 274 | test -z "$file" && file=`echo "$*" | sed -n "$sed_minuso"` 275 | if test -f "$file"; then 276 | touch $file 277 | else 278 | test -z "$file" || exec >$file 279 | echo ".ab help2man is required to generate this page" 280 | exit 1 281 | fi 282 | ;; 283 | 284 | makeinfo) 285 | echo 1>&2 "\ 286 | WARNING: \`$1' is $msg. You should only need it if 287 | you modified a \`.texi' or \`.texinfo' file, or any other file 288 | indirectly affecting the aspect of the manual. The spurious 289 | call might also be the consequence of using a buggy \`make' (AIX, 290 | DU, IRIX). You might want to install the \`Texinfo' package or 291 | the \`GNU make' package. Grab either from any GNU archive site." 292 | # The file to touch is that specified with -o ... 293 | file=`echo "$*" | sed -n "$sed_output"` 294 | test -z "$file" && file=`echo "$*" | sed -n "$sed_minuso"` 295 | if test -z "$file"; then 296 | # ... or it is the one specified with @setfilename ... 297 | infile=`echo "$*" | sed 's/.* \([^ ]*\) *$/\1/'` 298 | file=`sed -n ' 299 | /^@setfilename/{ 300 | s/.* \([^ ]*\) *$/\1/ 301 | p 302 | q 303 | }' $infile` 304 | # ... or it is derived from the source name (dir/f.texi becomes f.info) 305 | test -z "$file" && file=`echo "$infile" | sed 's,.*/,,;s,.[^.]*$,,'`.info 306 | fi 307 | # If the file does not exist, the user really needs makeinfo; 308 | # let's fail without touching anything. 309 | test -f $file || exit 1 310 | touch $file 311 | ;; 312 | 313 | tar) 314 | shift 315 | 316 | # We have already tried tar in the generic part. 317 | # Look for gnutar/gtar before invocation to avoid ugly error 318 | # messages. 319 | if (gnutar --version > /dev/null 2>&1); then 320 | gnutar "$@" && exit 0 321 | fi 322 | if (gtar --version > /dev/null 2>&1); then 323 | gtar "$@" && exit 0 324 | fi 325 | firstarg="$1" 326 | if shift; then 327 | case $firstarg in 328 | *o*) 329 | firstarg=`echo "$firstarg" | sed s/o//` 330 | tar "$firstarg" "$@" && exit 0 331 | ;; 332 | esac 333 | case $firstarg in 334 | *h*) 335 | firstarg=`echo "$firstarg" | sed s/h//` 336 | tar "$firstarg" "$@" && exit 0 337 | ;; 338 | esac 339 | fi 340 | 341 | echo 1>&2 "\ 342 | WARNING: I can't seem to be able to run \`tar' with the given arguments. 343 | You may want to install GNU tar or Free paxutils, or check the 344 | command line arguments." 345 | exit 1 346 | ;; 347 | 348 | *) 349 | echo 1>&2 "\ 350 | WARNING: \`$1' is needed, and is $msg. 351 | You might have modified some files without having the 352 | proper tools for further handling them. Check the \`README' file, 353 | it often tells you about the needed prerequisites for installing 354 | this package. You may also peek at any GNU archive site, in case 355 | some other package would contain this missing \`$1' program." 356 | exit 1 357 | ;; 358 | esac 359 | 360 | exit 0 361 | 362 | # Local variables: 363 | # eval: (add-hook 'write-file-hooks 'time-stamp) 364 | # time-stamp-start: "scriptversion=" 365 | # time-stamp-format: "%:y-%02m-%02d.%02H" 366 | # time-stamp-end: "$" 367 | # End: 368 | -------------------------------------------------------------------------------- /R/03dist.R: -------------------------------------------------------------------------------- 1 | # Distribution Functions 2 | # 3 | # Author: nmorris 4 | ############################################################################### 5 | 6 | 7 | ########################### 8 | # normal 9 | ########################### 10 | grnorm=function(n, mean = 0, sd = 1, type="d") { 11 | typeno=.type_num(type) 12 | if(typeno > 1L) 13 | stop("Normal variates must be of type 'double' or 'single.'") 14 | n=as.integer(n)[1] 15 | if(class(mean)!="gvector") 16 | mean=as.gvector(mean, type=typeno) 17 | if(class(sd)!="gvector") 18 | sd=as.gvector(sd, type=typeno) 19 | if(mean@type!=typeno) 20 | mean=convertType(mean,typeno) 21 | if(sd@type!=typeno) 22 | sd=convertType(sd,typeno) 23 | checkDevice(c(mean@device,sd@device)) 24 | new("gvector",ptr=.Call("gpu_rnorm", n,mean@ptr,sd@ptr,mean@length,sd@length, typeno),length=n, type=typeno) 25 | } 26 | 27 | 28 | 29 | gdnorm = function (x, mean = 0, sd = 1, log = FALSE, type="d") { 30 | typeno=.type_num(type) 31 | if(typeno > 1L) 32 | stop("Normal variates must be of type 'double' or 'single.'") 33 | n=as.integer(length(x)) 34 | 35 | if(class(mean)!="gvector") 36 | mean=as.gvector(mean, type=typeno) 37 | if(class(sd)!="gvector") 38 | sd=as.gvector(sd, type=typeno) 39 | if(class(x)!="gvector") 40 | x=as.gvector(x, type=typeno) 41 | 42 | if(mean@type!=typeno) 43 | mean=convertType(mean,typeno) 44 | if(sd@type!=typeno) 45 | sd=convertType(sd,typeno) 46 | if(x@type!=typeno) 47 | x=convertType(x,typeno) 48 | 49 | log=as.logical(log[1]) 50 | if(log!=TRUE && log!=FALSE) 51 | stop("'log' must be TRUE or FALSE") 52 | 53 | #gpu_dnorm(SEXP in_n, SEXP in_x, SEXP in_mean, SEXP in_sd, SEXP in_n_mean, SEXP in_n_sd, 54 | # SEXP in_log 55 | checkDevice(c(x@device, mean@device, sd@device)) 56 | new("gvector",ptr=.Call("gpu_dnorm", n,x@ptr, mean@ptr,sd@ptr,mean@length,sd@length, log, typeno),length=n, type=typeno) 57 | } 58 | 59 | 60 | gqnorm = function (q, mean = 0, sd = 1, lower.tail = TRUE, log.p = FALSE, warn=TRUE, type="d") { 61 | n=as.integer(length(q)) 62 | 63 | typeno=.type_num(type) 64 | if(typeno > 1L) 65 | stop("Normal variates must be of type 'double' or 'single.'") 66 | 67 | if(class(mean)!="gvector") 68 | mean=as.gvector(mean, type=typeno) 69 | if(class(sd)!="gvector") 70 | sd=as.gvector(sd, type=typeno) 71 | if(class(q)!="gvector") 72 | q=as.gvector(q, type=typeno) 73 | 74 | if(mean@type!=typeno) 75 | mean=convertType(mean,typeno) 76 | if(sd@type!=typeno) 77 | sd=convertType(sd,typeno) 78 | if(q@type!=typeno) 79 | q=convertType(q,typeno) 80 | 81 | log.p=as.logical(log.p[1]) 82 | if(log.p!=TRUE && log.p!=FALSE) 83 | stop("'log' must be TRUE or FALSE") 84 | lower.tail=lower.tail[1] 85 | if(lower.tail!=TRUE && lower.tail!=FALSE) 86 | stop("'log' must be TRUE or FALSE") 87 | if(warn) 88 | warning("'gqnorm' may not be accurate in the extreme tails.\n You can turn this message off with the 'warn' parameter.") 89 | #SEXP gpu_pnorm(SEXP in_n, SEXP in_x, SEXP in_mean, SEXP in_sd, SEXP in_n_mean, SEXP in_n_sd, 90 | # SEXP in_log, SEXP in_lower); 91 | checkDevice(c(q@device, mean@device, sd@device)) 92 | new("gvector",ptr=.Call("gpu_qnorm", n,q@ptr, mean@ptr,sd@ptr,mean@length,sd@length, log.p, lower.tail, typeno),length=n, type=typeno) 93 | } 94 | 95 | 96 | gpnorm = function (p, mean = 0, sd = 1, lower.tail = TRUE, log.p = FALSE, warn=TRUE, type="d") { 97 | n=as.integer(length(p)) 98 | typeno=.type_num(type) 99 | if(typeno > 1L) 100 | stop("Normal variates must be of type 'double' or 'single.'") 101 | 102 | if(class(mean)!="gvector") 103 | mean=as.gvector(mean, type=typeno) 104 | if(class(sd)!="gvector") 105 | sd=as.gvector(sd) 106 | if(class(p)!="gvector") 107 | p=as.gvector(p, type=typeno) 108 | 109 | if(mean@type!=typeno) 110 | mean=convertType(mean,typeno) 111 | if(sd@type!=typeno) 112 | sd=convertType(sd,typeno) 113 | if(p@type!=typeno) 114 | p=convertType(p,typeno) 115 | 116 | log.p=as.logical(log.p[1]) 117 | if(log.p!=TRUE && log.p!=FALSE) 118 | stop("'log' must be TRUE or FALSE") 119 | lower.tail=lower.tail[1] 120 | if(lower.tail!=TRUE && lower.tail!=FALSE) 121 | stop("'log' must be TRUE or FALSE") 122 | if(warn) 123 | warning("'gpnorm' may not be accurate in the extreme tails.\n You can turn this message off with the 'warn' parameter.") 124 | #SEXP gpu_pnorm(SEXP in_n, SEXP in_x, SEXP in_mean, SEXP in_sd, SEXP in_n_mean, SEXP in_n_sd, 125 | # SEXP in_log, SEXP in_lower); 126 | checkDevice(c(p@device, mean@device, sd@device)) 127 | new("gvector",ptr=.Call("gpu_pnorm", n,p@ptr, mean@ptr,sd@ptr,mean@length,sd@length, log.p, lower.tail, typeno),length=n, type=typeno) 128 | } 129 | ########################### 130 | # gamma 131 | ########################### 132 | grgamma=function(n, shape, rate = 1, scale = 1/rate, type="d") { 133 | n=as.integer(n)[1] 134 | typeno=.type_num(type) 135 | if(typeno > 1L) 136 | stop("Normal variates must be of type 'double' or 'single.'") 137 | 138 | if(class(shape)!="gvector") 139 | shape=as.gvector(shape, type=typeno) 140 | if(class(scale)!="gmatrix") 141 | scale=as.gvector(scale, type=typeno) 142 | 143 | if(shape@type!=typeno) 144 | shape=convertType(shape,typeno) 145 | if(scale@type!=typeno) 146 | scale=convertType(scale,typeno) 147 | 148 | checkDevice(c(shape@device, scale@device)) 149 | new("gvector",ptr=.Call("gpu_rgamma", n,shape@ptr,scale@ptr,shape@length,scale@length, typeno),length=n, type=typeno) 150 | } 151 | 152 | gdgamma=function(x, shape, rate = 1, scale = 1/rate, log = FALSE, type="d"){ 153 | n=as.integer(length(x)) 154 | typeno=.type_num(type) 155 | if(typeno > 1L) 156 | stop("Normal variates must be of type 'double' or 'single.'") 157 | 158 | if(class(shape)!="gvector") 159 | shape=as.gvector(shape, type=typeno) 160 | if(class(scale)!="gvector") 161 | scale=as.gvector(scale, type=typeno) 162 | if(class(x)!="gvector") 163 | x=as.gvector(x) 164 | 165 | if(shape@type!=typeno) 166 | shape=convertType(shape,typeno) 167 | if(scale@type!=typeno) 168 | scale=convertType(scale,typeno) 169 | if(x@type!=typeno) 170 | x=convertType(x,typeno) 171 | 172 | log=as.logical(log[1]) 173 | if(log!=TRUE && log!=FALSE) 174 | stop("'log' must be TRUE or FALSE") 175 | 176 | checkDevice(c(x@device, shape@device, scale@device)) 177 | new("gvector",ptr=.Call("gpu_dgamma", n,x@ptr, shape@ptr,scale@ptr,shape@length,scale@length, log, typeno),length=n, type=typeno) 178 | } 179 | 180 | 181 | ########################### 182 | # uniform 183 | ########################### 184 | grunif=function(n, min=0, max=1, type="d") 185 | 186 | { 187 | n=as.integer(n)[1] 188 | typeno=.type_num(type) 189 | if(typeno>1L) 190 | stop("Ivalid type.") 191 | if(typeno > 1) 192 | stop("Normal variates must be of type 'double' or 'single.'") 193 | 194 | if(class(min)!="gvector") 195 | min=as.gvector(min, type=typeno) 196 | if(class(max)!="gmatrix") 197 | max=as.gvector(max, type=typeno) 198 | 199 | if(min@type!=typeno) 200 | min=convertType(min,typeno) 201 | if(min@type!=typeno) 202 | min=convertType(min,typeno) 203 | 204 | checkDevice(c(min@device, max@device)) 205 | new("gvector",ptr=.Call("gpu_runif", n,min@ptr,max@ptr,min@length,max@length,typeno), 206 | length=n, type=typeno) 207 | } 208 | 209 | gdunif=function(x, min=0, max=1, log = FALSE, type="d"){ 210 | n=as.integer(length(x)) 211 | typeno=.type_num(type) 212 | if(typeno>1L) 213 | stop("Ivalid type.") 214 | if(typeno > 1) 215 | stop("Normal variates must be of type 'double' or 'single.'") 216 | 217 | if(class(min)!="gvector") 218 | min=as.gvector(min, type=typeno) 219 | if(class(max)!="gvector") 220 | max=as.gvector(max, type=typeno) 221 | if(class(x)!="gvector") 222 | x=as.gvector(x) 223 | 224 | if(min@type!=typeno) 225 | min=convertType(min,typeno) 226 | if(min@type!=typeno) 227 | min=convertType(min,typeno) 228 | if(x@type!=typeno) 229 | x=convertType(x,typeno) 230 | 231 | log=as.logical(log[1]) 232 | if(log!=TRUE && log!=FALSE) 233 | stop("'log' must be TRUE or FALSE") 234 | checkDevice(c(x@device,min@device,max@device)) 235 | new("gvector",ptr=.Call("gpu_dunif", n,x@ptr, min@ptr,max@ptr,min@length,max@length, log,typeno),length=n,type=typeno) 236 | } 237 | 238 | 239 | ########################### 240 | # beta 241 | ########################### 242 | grbeta=function(n, shape1, shape2, ncp = 0, type="d") { 243 | n=as.integer(n)[1] 244 | typeno=.type_num(type) 245 | if(typeno>1L) 246 | stop("Ivalid type.") 247 | if(typeno > 1) 248 | stop("Normal variates must be of type 'double' or 'single.'") 249 | 250 | if(!is.double(ncp)) 251 | ncp=as.double(ncp) 252 | if(!all(ncp==0)) 253 | stop("Noncental beta not implement on the GPU") 254 | 255 | if(class(shape1)!="gvector") 256 | shape1=as.gvector(shape1, type=typeno) 257 | if(class(shape2)!="gvector") 258 | shape2=as.gvector(shape2, type=typeno) 259 | 260 | if(shape1@type!=typeno) 261 | shape1=convertType(shape1,typeno) 262 | if(shape2@type!=typeno) 263 | shape2=convertType(shape2,typeno) 264 | 265 | checkDevice(c(shape1@device,shape2@device)) 266 | new("gvector",ptr=.Call("gpu_rbeta", n,shape1@ptr,shape2@ptr,shape1@length,shape2@length,typeno), 267 | length=n, type=typeno) 268 | } 269 | 270 | gdbeta=function(x, shape1, shape2, ncp = 0, log = FALSE, type="d") { 271 | n=as.integer(length(x)) 272 | typeno=.type_num(type) 273 | if(typeno>1L) 274 | stop("Ivalid type.") 275 | if(typeno > 1) 276 | stop("Normal variates must be of type 'double' or 'single.'") 277 | 278 | if(!all(ncp==0)) 279 | stop("Noncental beta not implement on the GPU") 280 | if(class(shape1)!="gvector") 281 | shape1=as.gvector(shape1) 282 | if(class(shape2)!="gvector") 283 | shape2=as.gvector(shape2) 284 | if(class(x)!="gvector") 285 | x=as.gvector(x) 286 | 287 | if(shape1@type!=typeno) 288 | shape1=convertType(shape1,typeno) 289 | if(shape2@type!=typeno) 290 | shape2=convertType(shape2,typeno) 291 | if(x@type!=typeno) 292 | x=convertType(x,typeno) 293 | 294 | 295 | log=as.logical(log[1]) 296 | if(log!=TRUE && log!=FALSE) 297 | stop("'log' must be TRUE or FALSE") 298 | checkDevice(c(x@device,shape1@device,shape2@device)) 299 | new("gvector",ptr=.Call("gpu_dbeta", n,x@ptr, shape1@ptr,shape2@ptr,shape1@length,shape2@length, log,typeno),length=n,type=typeno) 300 | } 301 | 302 | ########################### 303 | # binomial 304 | ########################### 305 | grbinom=function(n, size, prob) 306 | { 307 | n=as.integer(n)[1] 308 | if(class(size)!="gvector") 309 | size=as.gvector(size) 310 | if(class(prob)!="gmatrix") 311 | prob=as.gvector(prob) 312 | if(size@type==1L && prob@type==1L) 313 | typeno=1L 314 | else 315 | typeno=0L 316 | 317 | if(size@type!=typeno) 318 | size=convertType(size,typeno) 319 | if(prob@type!=typeno) 320 | prob=convertType(prob,typeno) 321 | 322 | checkDevice(c(size@device,prob@device)) 323 | new("gvector",ptr=.Call("gpu_rbinom", n,size@ptr,prob@ptr,size@length,prob@length, typeno),length=n, type=2L) 324 | } 325 | 326 | gdbinom=function(x, size, prob, log = FALSE, type="d") { 327 | n=as.integer(length(x)) 328 | typeno=.type_num(type) 329 | if(typeno>1L) 330 | stop("Ivalid type.") 331 | if(class(size)!="gvector") 332 | size=as.gvector(size) 333 | if(class(prob)!="gvector") 334 | prob=as.gvector(prob) 335 | if(class(x)!="gvector") 336 | x=as.gvector(x) 337 | 338 | log=log[1] 339 | if(log!=TRUE && log!=FALSE) 340 | stop("'log' must be TRUE or FALSE") 341 | 342 | if(size@type!=typeno) 343 | size=convertType(size,typeno) 344 | if(prob@type!=typeno) 345 | prob=convertType(prob,typeno) 346 | if(x@type!=typeno) 347 | x=convertType(x,typeno) 348 | 349 | checkDevice(c(x@device,size@device,prob@device)) 350 | new("gvector",ptr=.Call("gpu_dbinom", n,x@ptr, size@ptr,prob@ptr,size@length,prob@length, log, typeno),length=n, type=typeno) 351 | } 352 | ########################### 353 | # poison 354 | ########################### 355 | grpois=function(n, lambda) { 356 | n=as.integer(n)[1] 357 | if(class(lambda)!="gvector") 358 | lambda=as.gvector(lambda) 359 | if(lambda@type>1L) 360 | type(lambda)=0L 361 | checkDevice(c(lambda@device)) 362 | new("gvector",ptr=.Call("gpu_rpois", n,lambda@ptr,lambda@length,lambda@type), 363 | length=n, type=2L) 364 | } 365 | 366 | gdpois=function(x, lambda, log = FALSE, type="d") { 367 | n=as.integer(length(x)) 368 | typeno=.type_num(type) 369 | if(typeno>1L) 370 | stop("Ivalid type.") 371 | if(class(lambda)!="gvector") 372 | lambda=as.gvector(lambda) 373 | if(class(x)!="gvector") 374 | x=as.gvector(x) 375 | log=log[1] 376 | if(log!=TRUE && log!=FALSE) 377 | stop("'log' must be TRUE or FALSE") 378 | if(lambda@type!=typeno) 379 | lambda=convertType(lambda,typeno) 380 | if(x@type!=typeno) 381 | x=convertType(x,typeno) 382 | checkDevice(c(x@device,lambda@device)) 383 | new("gvector",ptr=.Call("gpu_dpois", n, x@ptr, lambda@ptr,lambda@length, log, typeno),length=n, type=typeno) 384 | } 385 | 386 | ########################### 387 | # rsample 388 | ########################### 389 | rsample = function(P, log=TRUE) { 390 | if(class(P)!="gmatrix") 391 | stop("Object must be of class 'gmatrix.'") 392 | if(!log) 393 | P=log(P) 394 | #SEXP gpu_rsample(SEXP in_P, SEXP in_rows, SEXP in_cols, SEXP in_norm, SEXP in_type); 395 | norm = gRowLogSums(P) 396 | return(new("gvector", ptr=.Call("gpu_rsample",P@ptr, nrow(P), ncol(P),norm@ptr, P@type), length=nrow(P), type=2L)) 397 | } 398 | 399 | -------------------------------------------------------------------------------- /R/02gvector.R: -------------------------------------------------------------------------------- 1 | # gvector definitions 2 | # 3 | # Author: nmorris 4 | ############################################################################### 5 | 6 | setClass("gvector", 7 | representation( 8 | ptr="ANY", 9 | length = "integer", 10 | names = "ANY", 11 | type="integer", 12 | device = "integer"), 13 | prototype = list( 14 | ptr=NULL, 15 | length=NULL, 16 | names=NULL, 17 | type=100L, 18 | device=0L) 19 | ) 20 | 21 | setMethod("initialize", 22 | "gvector", 23 | function(.Object,...) { 24 | #cat("test\n") 25 | # browser() 26 | .Object <- callNextMethod() 27 | .Object@device=.Call("get_device") 28 | return(.Object) 29 | }) 30 | 31 | 32 | gvector = function(length, type="d") { 33 | return(g.rep(0, times=length, type=type)) 34 | } 35 | 36 | g.rep =function(x, times=1L, each=1L, type=NULL) { 37 | if(is.null(type)) 38 | tryCatch(typeno<- .Rclass_to_type(x), 39 | error=function(i) stop("Class of data cannot be converted to gpu type.", call. = FALSE)) 40 | else 41 | typeno=.type_num(type) 42 | times=as.integer(times[1]) 43 | each=as.integer(each[1]) 44 | ret = new("gvector",length=as.integer(length(x)*times*each), type=typeno) 45 | if(length(ret)==0) 46 | return(ret) 47 | if(length(x)==1L) { 48 | tryCatch(x <- .convert_to_appropriate_class(x,typeno), error=function(e) stop("Invalid value for x, or invalid type.", call. = FALSE)) 49 | ret@ptr = .Call("gpu_rep_1",x,length(ret) ,typeno)#gpu_rep_1(SEXP in_val, SEXP in_N) 50 | } else { 51 | 52 | if(class(x)!="gvector") 53 | x=as.gvector(x) 54 | x=convertType(x,typeno,dup=FALSE) 55 | x@names=NULL 56 | 57 | ret@ptr = .Call("gpu_rep_m", x@ptr, as.integer(length(x)), times, each , typeno)#gpu_rep_m(SEXP in_A,SEXP in_n, SEXP in_N, SEXP in_times_each); 58 | } 59 | 60 | return(ret) 61 | } 62 | 63 | .gcolon = function(a,b, type=NULL) { 64 | #SEXP gpu_seq( SEXP n_in, SEXP init_in, SEXP step_in, SEXP in_type ) 65 | a=a[1];b=b[1] 66 | if(is.null(type)) { 67 | typeno=.Rclass_to_type_int(a) 68 | } else { 69 | typeno=.type_num(type) 70 | } 71 | if(typeno==0L || typeno==1L) { 72 | a=as.double(a) 73 | b=as.double(b) 74 | n=as.integer(floor(abs(b-a)+1L)) 75 | step=as.double(sign(b-a)) 76 | } else if(typeno==2) { 77 | a=as.integer(a) 78 | b=as.integer(b) 79 | n=as.integer(abs(a-b)+1L) 80 | step=as.integer(sign(b-a)) 81 | } else 82 | stop("Invalid type.") 83 | return(.Call("gpu_seq", n, a, step, typeno)) 84 | 85 | 86 | #gpu_seq( SEXP n_in, SEXP init_in, SEXP step_in, SEXP in_type ) 87 | } 88 | 89 | setGeneric("%to%", 90 | function(from,to) 91 | standardGeneric("%to%") 92 | ) 93 | 94 | setMethod("%to%", c("numeric","numeric"), 95 | function(from,to) { 96 | return(.gcolon(from,to)) 97 | }) 98 | 99 | .seq = function(n,from,by, type=NULL) { 100 | 101 | if(is.null(type)) { 102 | typeno=min(.Rclass_to_type_int(from),.Rclass_to_type_int(by)) 103 | } else { 104 | typeno=.type_num(type) 105 | } 106 | if(typeno==0L || typeno==1L) { 107 | from=as.double(from) 108 | by=as.double(by) 109 | } else if(typeno==2) { 110 | from=as.integer(from) 111 | by=as.integer(by) 112 | } else 113 | stop("Invalid type.",call. = FALSE) 114 | return(.Call("gpu_seq", as.integer(n), from, by, typeno)) 115 | 116 | 117 | #gpu_seq( SEXP n_in, SEXP init_in, SEXP step_in, SEXP in_type ) 118 | } 119 | 120 | #modified from the R seq function 121 | gseq = function (from = 1, to = 1, by = ((to - from)/(length.out - 1)), 122 | length.out = NULL, along.with = NULL, type=NULL) 123 | { 124 | if ((One <- nargs() == 1L) && !missing(from)) { 125 | lf <- length(from) 126 | return(if (mode(from) == "numeric" && lf == 1L) .gcolon(1L,from,type) else if (lf) .gcolon(1L,lf,type) else gvector(0L,type="i")) 127 | } 128 | if (!missing(along.with)) { 129 | length.out <- length(along.with) 130 | if (One) 131 | return(if (length.out) .gcolon(1L,length.out,type) else gvector(0L,type="i")) 132 | } 133 | else if (!missing(length.out)) 134 | length.out <- ceiling(length.out) 135 | if (is.null(length.out)) 136 | if (missing(by)) 137 | .gcolon(from,to,type) 138 | else { 139 | del <- to - from 140 | if (del == 0 && to == 0) 141 | return(as.gvector(to)) 142 | n <- del/by 143 | if (!(length(n) && is.finite(n))) { 144 | if (length(by) && by == 0 && length(del) && del == 145 | 0) 146 | return(as.gvector(from)) 147 | stop("invalid (to - from)/by in seq(.)") 148 | } 149 | if (n < 0L) 150 | stop("wrong sign in 'by' argument") 151 | if (n > .Machine$integer.max) 152 | stop("'by' argument is much too small") 153 | dd <- abs(del)/max(abs(to), abs(from)) 154 | if (dd < 100 * .Machine$double.eps) 155 | return(as.gvector(from)) 156 | if(abs(as.integer(n)-n)<100 * .Machine$double.eps){ 157 | n=as.integer(round(n)+1L) 158 | tmp=.seq(n,from,by) 159 | tmp[n]=to 160 | return(tmp) 161 | } else { 162 | n=as.integer(n) 163 | return(.seq(n,from,by)) 164 | } 165 | 166 | } 167 | else if (!is.finite(length.out) || length.out < 0L) 168 | stop("length must be non-negative number") 169 | else if (length.out == 0L) 170 | gvector(0L,type="i") 171 | else if (One) 172 | .gcolon(1L,length.out) 173 | else if (missing(by)) { 174 | if (missing(to)) 175 | to <- from + length.out - 1L 176 | if (missing(from)) 177 | from <- to - length.out + 1L 178 | if (length.out > 2L) 179 | .seq(length.out,from,by) 180 | } 181 | else if (missing(to)) 182 | .seq(length.out,from,by) 183 | #from + (0L:(length.out - 1L)) * by 184 | else if (missing(from)) 185 | .seq(length.out,to,-by) 186 | #to - ((length.out - 1L):0L) * by 187 | else stop("too many arguments") 188 | } 189 | 190 | 191 | 192 | setGeneric("as.gvector", useAsDefault=function(x, type=NULL, dup=TRUE) { 193 | #browser() 194 | tryCatch(fromtype<- .Rclass_to_type(x), 195 | error=function(i) stop("Class of data cannot be converted to gpu type.", call. = FALSE)) 196 | 197 | if(is.null(type)) { 198 | typeno<-fromtype 199 | } else 200 | typeno=.type_num(type) 201 | 202 | ret = new("gvector",length=length(x), type=fromtype, names=names(x)) 203 | if(length(ret)==0L) 204 | return(ret) 205 | 206 | ret@ptr = .Call("gpu_create", x, fromtype) 207 | 208 | if(typeno!=fromtype) 209 | ret=convertType(ret,typeno) 210 | 211 | if(length(names(x))!=0) 212 | if(length(tmp)==length(names(x))) 213 | ret@names=names(x) 214 | 215 | return(ret) 216 | }) 217 | 218 | setMethod("as.gvector", "gmatrix", 219 | function(x, type=x@type, dup=TRUE) { 220 | checkDevice(x@device) 221 | typeno=.type_num(type) 222 | mylength=as.integer(prod(dim(x))) 223 | ret = new("gvector", length=mylength, type=typeno) 224 | if(length(ret)==0L) 225 | return(ret) 226 | if(x@type==typeno) { 227 | if(dup) 228 | ret@ptr = .Call("gpu_duplicate", x@ptr, mylength, typeno)#duplicate x@ptr 229 | else 230 | ret@ptr = x@ptr 231 | } else { 232 | tmp=convertType(x,typeno,dup) 233 | ret@ptr=tmp@ptr 234 | } 235 | 236 | return(ret) 237 | }) 238 | 239 | setMethod("as.gvector", "gvector", 240 | function(x, type=x@type, dup=TRUE) { 241 | checkDevice(x@device) 242 | typeno=.type_num(type) 243 | if(x@type==typeno) { 244 | if(dup) 245 | ret = gdup(x) 246 | else 247 | ret = x 248 | } else { 249 | ret=convertType(x,typeno,dup) 250 | } 251 | return(ret) 252 | }) 253 | 254 | 255 | setMethod("as.numeric", "gvector", 256 | function(x) { 257 | checkDevice(x@device) 258 | ret=.gpu_get( x@ptr, x@length, x@type) 259 | # if(!namestrip && length(names(x))>0) 260 | # names(ret)=names(x) 261 | return(as.numeric(ret)) 262 | }) 263 | 264 | setMethod("as.integer", "gvector", 265 | function(x) { 266 | checkDevice(x@device) 267 | ret=.gpu_get( x@ptr, x@length, x@type) 268 | # if(!namestrip && length(names(x))>0) 269 | # names(ret)=names(x) 270 | return(as.integer(ret)) 271 | }) 272 | 273 | setMethod("as.logical", "gvector", 274 | function(x) { 275 | checkDevice(x@device) 276 | ret=.gpu_get( x@ptr, x@length, x@type) 277 | # if(length(names(x))>0) 278 | # names(ret)=names(x) 279 | return(as.logical(ret)) 280 | }) 281 | 282 | #setGeneric("as.vector", 283 | # function(x, ...) 284 | # base::as.vector(x,...) 285 | #) 286 | 287 | as.vector.gvector = function(x, mode=NULL) { 288 | checkDevice(x@device) 289 | ret=.gpu_get( x@ptr, x@length, x@type) 290 | if(!is.null(mode) & mode!="any") 291 | mode(ret)=mode 292 | return(ret) 293 | } 294 | 295 | 296 | setMethod("as.vector", "gvector",as.vector.gvector) 297 | 298 | 299 | 300 | 301 | setMethod("length", "gvector", 302 | function(x) { 303 | return(x@length) 304 | }) 305 | 306 | setMethod("names", "gvector", 307 | function(x) { 308 | return(x@names) 309 | }) 310 | 311 | 312 | setReplaceMethod("names", "gvector", 313 | function(x, value) { 314 | if(is.null(value)) 315 | x@names <- NULL 316 | else if(length(x) != length(value)) 317 | stop("'names' attribute must be the same length as the vector.") 318 | else 319 | x@names <- as.character(value) 320 | return(x) 321 | } 322 | ) 323 | #setReplaceMethod("length", "gvector", 324 | # function(x, value) { 325 | # value=as.integer(value) 326 | # x@length <- value 327 | # return(x) 328 | # } 329 | #) 330 | 331 | #device = function(x) { 332 | # stop(paste("'device' not defined for class:",class(x))) 333 | #} 334 | setGeneric("device", 335 | function(x) 336 | standardGeneric("device") 337 | ) 338 | 339 | setMethod("device", "gmatrix", 340 | function(x) { 341 | return(x@device) 342 | }) 343 | setMethod("device", "gvector", 344 | function(x) { 345 | return(x@device) 346 | }) 347 | 348 | setGeneric("device<-", function(x, value) 349 | standardGeneric("device<-")) 350 | 351 | setReplaceMethod("device", "gmatrix", 352 | function(x, value) { 353 | curD=getDevice() 354 | value=as.integer(value)[1] 355 | if(x@device!=value) { 356 | if(x@device!=curD) 357 | setDevice(x@device, silent=TRUE) 358 | x=h(x) 359 | setDevice(value, silent=TRUE) 360 | x=g(x) 361 | if(getDevice()!=curD) 362 | setDevice(curD, silent=TRUE) 363 | } 364 | return(x) 365 | }) 366 | 367 | setReplaceMethod("device", "gvector", 368 | function(x, value) { 369 | curD=getDevice() 370 | value=as.integer(value)[1] 371 | if(x@device!=value) { 372 | if(x@device!=curD) 373 | setDevice(x@device, silent=TRUE) 374 | x=h(x) 375 | setDevice(value, silent=TRUE) 376 | x=g(x) 377 | if(getDevice()!=curD) 378 | setDevice(curD, silent=TRUE) 379 | } 380 | return(x) 381 | }) 382 | 383 | 384 | #type = function(x) { 385 | # stop(paste("'type' not defined for class:",class(x))) 386 | #} 387 | setGeneric("type", function(x) 388 | standardGeneric("type")) 389 | setMethod("type", "gmatrix", 390 | function(x) { 391 | return(.type_name(x@type)) 392 | }) 393 | setMethod("type", "gvector", 394 | function(x) { 395 | return(.type_name(x@type)) 396 | }) 397 | 398 | setGeneric("type<-", function(x, value) 399 | standardGeneric("type<-")) 400 | setReplaceMethod("type", "gmatrix", 401 | function(x, value) { 402 | checkDevice(x@device) 403 | typeno=.type_num(value) 404 | ret=convertType(x,typeno,dup=FALSE) 405 | return(ret) 406 | }) 407 | 408 | setReplaceMethod("type", "gvector", 409 | function(x, value) { 410 | checkDevice(x@device) 411 | typeno=.type_num(value) 412 | ret=convertType(x,typeno,dup=FALSE) 413 | return(ret) 414 | }) 415 | 416 | setMethod("show","gvector", 417 | function(object) { 418 | 419 | #checkDevice(object@device) 420 | cat(paste("gvector of length", object@length, "and type", sQuote(type(object)),"on gpu", device(object)), ":\n",sep="") 421 | #print(object@ptr) 422 | if(length(object)>0) { 423 | curD=getDevice() 424 | flg=FALSE 425 | if(object@device!=curD) { 426 | setDevice(object@device, silent=TRUE) 427 | flg=TRUE 428 | } 429 | tmp=h(object) 430 | if(flg) 431 | setDevice(curD, silent=TRUE) 432 | if(length(object)>20) 433 | cat("printing first 20 elements: \n") 434 | print(tmp[1:min(20,length(object))]) 435 | } 436 | }) 437 | 438 | 439 | 440 | setMethod("t", "gvector", 441 | function(x) { 442 | return(t(gmatrix(x))) 443 | } 444 | ) 445 | 446 | setMethod("[", "gvector", 447 | function(x, i, j,...,drop=TRUE) { 448 | if(!missing(j)){ 449 | stop("incorrect number of dimenstions") 450 | } 451 | if(missing(i)) 452 | return(gdup(x)) 453 | checkDevice(x@device) 454 | i=.check_make_valid(i, length(x),names(x)) 455 | ret=new("gvector", 456 | ptr=.Call("gpu_numeric_index", x@ptr, length(x), i@ptr, length(i), x@type), 457 | length=length(i), type=x@type) 458 | 459 | if(!is.null(names(x))) 460 | names(ret)=names(x)[as.integer(i)] 461 | 462 | return(ret) 463 | } 464 | ) 465 | 466 | 467 | 468 | setReplaceMethod("[", "gvector", 469 | function(x, i, j,..., value) { 470 | 471 | if(!missing(j)){ 472 | stop("incorrect number of dimenstions") 473 | } 474 | if(!(class(value) %in% c("gvector","gmatrix"))) 475 | value=as.gvector(value, type=x@type, dup=FALSE) 476 | checkDevice(c(x@device, value@device)) 477 | if(x@type!=value@type) 478 | type(value)=x@type 479 | if(missing(i)){ 480 | if(length(value)!=length(x)) 481 | stop("Number of items to replace is not equal to the number of items") 482 | tmp=.Call("gpu_cpy",value@ptr, x@ptr, length(x),x@type) 483 | return(x) 484 | } 485 | 486 | i=.check_make_valid(i, length(x),names(x),TRUE) 487 | 488 | #gpu_numeric_index_set(SEXP A_in, SEXP n_A_in, SEXP val_in, SEXP n_val_in, SEXP index_in, SEXP n_index_in) 489 | junk=.Call("gpu_numeric_index_set", x@ptr, length(x), value@ptr, length(value), i@ptr, length(i), x@type) 490 | 491 | 492 | return(x) 493 | } 494 | ) 495 | 496 | as.matrix.gvector = function(x, ...) { 497 | checkDevice(x@device) 498 | ret=.gpu_get( x@ptr, x@length, x@type) 499 | if(length(names(x))>0) 500 | names(ret)=names(x) 501 | 502 | return(as.matrix(ret)) 503 | } 504 | 505 | setMethod("as.matrix", signature(x = "gvector"), as.matrix.gvector ) 506 | 507 | -------------------------------------------------------------------------------- /src/general.cu: -------------------------------------------------------------------------------- 1 | 2 | #define DEFINEGLOBALSHERE 3 | #include "gmatrix.h" 4 | 5 | 6 | void initialize_globals() 7 | { 8 | 9 | for(int i=0;i>>((dev_states[currentDevice]), seed, (total_states[currentDevice])); 169 | cudaStat = cudaDeviceSynchronize(); 170 | if (cudaStat != cudaSuccess ) { 171 | error("Kernal error from 'setup_curand.' (%d)'\n", (int) cudaStat); 172 | } 173 | 174 | dev_state_set[currentDevice]=1; 175 | } 176 | return in_total_states; 177 | } 178 | 179 | SEXP cudaVersion() { 180 | int myint = CUDART_VERSION; 181 | return(asSEXPint(myint)); 182 | } 183 | void startCublas(int* silent, int *set) { // must be called with .C interface - also starts cusolve 184 | cublasStatus_t status1; 185 | set[0]=0; 186 | if(dev_cublas_set[currentDevice]==0) { 187 | set[0]=1; 188 | if(silent[0]==0) 189 | Rprintf("Starting cublas on device %d.\n", currentDevice); 190 | status1 = cublasCreate(&(handle[currentDevice])); 191 | if (status1 != CUBLAS_STATUS_SUCCESS) { 192 | error("CUBLAS initialization error.\n"); 193 | } 194 | #if CUDART_VERSION >= 7000 195 | cusolverStatus_t s = cusolverDnCreate(&(cudshandle[currentDevice])); 196 | if(s != CUSOLVER_STATUS_SUCCESS) 197 | error("CUSOLVER initialization error.\n"); 198 | #endif 199 | dev_cublas_set[currentDevice]=1; 200 | 201 | } 202 | } 203 | 204 | 205 | 206 | void stopCublas(int* silent) { 207 | cublasStatus_t status1; 208 | //check_started(); 209 | if(dev_cublas_set[currentDevice]!=0) { 210 | if(silent[0]==0) 211 | Rprintf("Shutting down cublas on device %d", currentDevice); 212 | status1 = cublasDestroy((handle[currentDevice])); 213 | if (status1 != CUBLAS_STATUS_SUCCESS) { 214 | warning("CUBLAS shutdown error\n"); 215 | } 216 | #if CUDART_VERSION >= 7000 217 | cusolverStatus_t s = cusolverDnDestroy((cudshandle[currentDevice])); 218 | if(s != CUSOLVER_STATUS_SUCCESS) 219 | error("CUSOLVER shutdown error.\n"); 220 | #endif 221 | } 222 | } 223 | 224 | /* 225 | void RlistDevices(int* curdevice, int *memory, int *total, int *silent) { 226 | int deviceCount = 0; 227 | int i; 228 | cudaDeviceProp deviceProp; 229 | 230 | cudaGetDeviceCount(&deviceCount); 231 | 232 | if(deviceCount>20) 233 | error("to many devices to list."); 234 | for(i=0;i deviceCount)) 259 | error("The gpu id (%d) number is not valid.",device[0]); 260 | #ifdef DEBUG 261 | Rprintf("here"); 262 | #endif 263 | status1 = cudaSetDevice(device[0]); 264 | if (status1 != cudaSuccess) { 265 | if(status1 == cudaErrorSetOnActiveProcess) 266 | error("Active process. Can't set device.\n"); 267 | else if(status1 == cudaErrorInvalidDevice) 268 | error("Invalid Device\n"); 269 | else 270 | error("Unknown errors\n"); 271 | 272 | } else { 273 | currentDevice=device[0]; 274 | cudaDeviceProp deviceProp; 275 | cudaGetDeviceProperties(&deviceProp, device[0]); 276 | if(silent[0]==0) 277 | Rprintf("Now using device %d - \"%s\"\n", device[0], deviceProp.name); 278 | } 279 | /* 280 | GLOBAL __device__ int CUDA_R_Na_int; 281 | GLOBAL __device__ double CUDA_R_Na_double; 282 | GLOBAL __device__ float CUDA_R_Na_float; 283 | R defines the following 284 | void attribute_hidden InitArithmetic() 285 | { 286 | R_NaInt = INT_MIN; 287 | R_NaN = 0.0/R_Zero_Hack; 288 | R_NaReal = R_ValueOfNA(); 289 | R_PosInf = 1.0/R_Zero_Hack; 290 | R_NegInf = -1.0/R_Zero_Hack; 291 | }*/ 292 | float R_NaFloat = (float) R_NaReal; 293 | cudaMemcpyToSymbol(CUDA_R_Na_int, &R_NaInt, sizeof(int)); 294 | cudaMemcpyToSymbol(CUDA_R_Na_float, &R_NaFloat, sizeof(float)); 295 | cudaMemcpyToSymbol(CUDA_R_Na_double, &R_NaReal, sizeof(double)); 296 | 297 | } 298 | 299 | void deviceReset() { 300 | cudaError_t cudaStat; 301 | cudaStat=cudaDeviceReset(); 302 | CUDA_ERROR; 303 | 304 | } 305 | 306 | 307 | void setFlagSpin() { 308 | cudaError_t cudaStat; 309 | cudaStat= cudaSetDeviceFlags(cudaDeviceScheduleSpin); 310 | CUDA_ERROR; 311 | } 312 | void setFlagYield() { 313 | cudaError_t cudaStat; 314 | cudaStat= cudaSetDeviceFlags(cudaDeviceScheduleYield); 315 | CUDA_ERROR; 316 | } 317 | void setFlagBlock() { 318 | cudaError_t cudaStat; 319 | cudaStat= cudaSetDeviceFlags(cudaDeviceScheduleBlockingSync); 320 | CUDA_ERROR; 321 | } 322 | 323 | 324 | /* 325 | void d_PrintMatrix(double *d_matrix,int rows, int cols, int startRow, int stopRow) { 326 | double *matrix = Calloc(rows*cols, double); 327 | if (matrix == NULL ) { 328 | Rprintf("d_PrintMatrix: Could not allocate memory."); 329 | } else { 330 | cublasGetMatrix(rows, cols, sizeof(double), d_matrix, rows, matrix, rows); 331 | PrintMatrix(matrix, rows, cols, startRow, stopRow); 332 | Free(matrix); 333 | } 334 | } 335 | 336 | 337 | void PrintMatrix(double matrix[], int rows, int cols, int startRow, int stopRow) 338 | { 339 | int r,c; 340 | int row_stop= min(rows,stopRow); 341 | Rprintf("Matrix is: %d x %d \n", rows, cols); 342 | for(r=startRow;r 100000) 346 | // Rprintf("%1.10f ", matrix[c*rows + r]); 347 | // else 348 | Rprintf(" %e ", matrix[c*rows + r]); 349 | } 350 | Rprintf("\n"); 351 | } 352 | 353 | }*/ 354 | void check_mem(int *freer, int *totr, int *silent) { 355 | size_t free, total; 356 | cudaMemGetInfo(&free,&total); 357 | if(silent[0]==0) 358 | Rprintf("%d MB free out of %d MB total.\n",free/1048576,total/1048576); 359 | freer[0]=free; 360 | totr[0]=total; 361 | //mem[0]=(int) free; 362 | //mem[1]=(int) total; 363 | } 364 | 365 | 366 | 367 | SEXP get_device_info(SEXP property) 368 | { 369 | int deviceCount = 0; 370 | int i; 371 | cudaDeviceProp deviceProp; 372 | cudaError_t error_id = cudaGetDeviceCount(&deviceCount); 373 | if (error_id != cudaSuccess) 374 | { 375 | error("cudaGetDeviceCount returned %d\n-> %s\n", (int)error_id, cudaGetErrorString(error_id)); 376 | } 377 | 378 | SEXP ret; 379 | 380 | 381 | #define LOOK(MPROP,MDPROP) \ 382 | if(strcmp(CHAR(STRING_ELT(property, 0)), #MPROP) == 0) {\ 383 | PROTECT(ret = allocVector(INTSXP, deviceCount));\ 384 | for(i=0;i&2 149 | exit 1;; 150 | esac 151 | shift;; 152 | 153 | -o) chowncmd="$chownprog $2" 154 | shift;; 155 | 156 | -s) stripcmd=$stripprog;; 157 | 158 | -t) dst_arg=$2 159 | shift;; 160 | 161 | -T) no_target_directory=true;; 162 | 163 | --version) echo "$0 $scriptversion"; exit $?;; 164 | 165 | --) shift 166 | break;; 167 | 168 | -*) echo "$0: invalid option: $1" >&2 169 | exit 1;; 170 | 171 | *) break;; 172 | esac 173 | shift 174 | done 175 | 176 | if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then 177 | # When -d is used, all remaining arguments are directories to create. 178 | # When -t is used, the destination is already specified. 179 | # Otherwise, the last argument is the destination. Remove it from $@. 180 | for arg 181 | do 182 | if test -n "$dst_arg"; then 183 | # $@ is not empty: it contains at least $arg. 184 | set fnord "$@" "$dst_arg" 185 | shift # fnord 186 | fi 187 | shift # arg 188 | dst_arg=$arg 189 | done 190 | fi 191 | 192 | if test $# -eq 0; then 193 | if test -z "$dir_arg"; then 194 | echo "$0: no input file specified." >&2 195 | exit 1 196 | fi 197 | # It's OK to call `install-sh -d' without argument. 198 | # This can happen when creating conditional directories. 199 | exit 0 200 | fi 201 | 202 | if test -z "$dir_arg"; then 203 | trap '(exit $?); exit' 1 2 13 15 204 | 205 | # Set umask so as not to create temps with too-generous modes. 206 | # However, 'strip' requires both read and write access to temps. 207 | case $mode in 208 | # Optimize common cases. 209 | *644) cp_umask=133;; 210 | *755) cp_umask=22;; 211 | 212 | *[0-7]) 213 | if test -z "$stripcmd"; then 214 | u_plus_rw= 215 | else 216 | u_plus_rw='% 200' 217 | fi 218 | cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;; 219 | *) 220 | if test -z "$stripcmd"; then 221 | u_plus_rw= 222 | else 223 | u_plus_rw=,u+rw 224 | fi 225 | cp_umask=$mode$u_plus_rw;; 226 | esac 227 | fi 228 | 229 | for src 230 | do 231 | # Protect names starting with `-'. 232 | case $src in 233 | -*) src=./$src;; 234 | esac 235 | 236 | if test -n "$dir_arg"; then 237 | dst=$src 238 | dstdir=$dst 239 | test -d "$dstdir" 240 | dstdir_status=$? 241 | else 242 | 243 | # Waiting for this to be detected by the "$cpprog $src $dsttmp" command 244 | # might cause directories to be created, which would be especially bad 245 | # if $src (and thus $dsttmp) contains '*'. 246 | if test ! -f "$src" && test ! -d "$src"; then 247 | echo "$0: $src does not exist." >&2 248 | exit 1 249 | fi 250 | 251 | if test -z "$dst_arg"; then 252 | echo "$0: no destination specified." >&2 253 | exit 1 254 | fi 255 | 256 | dst=$dst_arg 257 | # Protect names starting with `-'. 258 | case $dst in 259 | -*) dst=./$dst;; 260 | esac 261 | 262 | # If destination is a directory, append the input filename; won't work 263 | # if double slashes aren't ignored. 264 | if test -d "$dst"; then 265 | if test -n "$no_target_directory"; then 266 | echo "$0: $dst_arg: Is a directory" >&2 267 | exit 1 268 | fi 269 | dstdir=$dst 270 | dst=$dstdir/`basename "$src"` 271 | dstdir_status=0 272 | else 273 | # Prefer dirname, but fall back on a substitute if dirname fails. 274 | dstdir=` 275 | (dirname "$dst") 2>/dev/null || 276 | expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ 277 | X"$dst" : 'X\(//\)[^/]' \| \ 278 | X"$dst" : 'X\(//\)$' \| \ 279 | X"$dst" : 'X\(/\)' \| . 2>/dev/null || 280 | echo X"$dst" | 281 | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ 282 | s//\1/ 283 | q 284 | } 285 | /^X\(\/\/\)[^/].*/{ 286 | s//\1/ 287 | q 288 | } 289 | /^X\(\/\/\)$/{ 290 | s//\1/ 291 | q 292 | } 293 | /^X\(\/\).*/{ 294 | s//\1/ 295 | q 296 | } 297 | s/.*/./; q' 298 | ` 299 | 300 | test -d "$dstdir" 301 | dstdir_status=$? 302 | fi 303 | fi 304 | 305 | obsolete_mkdir_used=false 306 | 307 | if test $dstdir_status != 0; then 308 | case $posix_mkdir in 309 | '') 310 | # Create intermediate dirs using mode 755 as modified by the umask. 311 | # This is like FreeBSD 'install' as of 1997-10-28. 312 | umask=`umask` 313 | case $stripcmd.$umask in 314 | # Optimize common cases. 315 | *[2367][2367]) mkdir_umask=$umask;; 316 | .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;; 317 | 318 | *[0-7]) 319 | mkdir_umask=`expr $umask + 22 \ 320 | - $umask % 100 % 40 + $umask % 20 \ 321 | - $umask % 10 % 4 + $umask % 2 322 | `;; 323 | *) mkdir_umask=$umask,go-w;; 324 | esac 325 | 326 | # With -d, create the new directory with the user-specified mode. 327 | # Otherwise, rely on $mkdir_umask. 328 | if test -n "$dir_arg"; then 329 | mkdir_mode=-m$mode 330 | else 331 | mkdir_mode= 332 | fi 333 | 334 | posix_mkdir=false 335 | case $umask in 336 | *[123567][0-7][0-7]) 337 | # POSIX mkdir -p sets u+wx bits regardless of umask, which 338 | # is incompatible with FreeBSD 'install' when (umask & 300) != 0. 339 | ;; 340 | *) 341 | tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$ 342 | trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0 343 | 344 | if (umask $mkdir_umask && 345 | exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1 346 | then 347 | if test -z "$dir_arg" || { 348 | # Check for POSIX incompatibilities with -m. 349 | # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or 350 | # other-writeable bit of parent directory when it shouldn't. 351 | # FreeBSD 6.1 mkdir -m -p sets mode of existing directory. 352 | ls_ld_tmpdir=`ls -ld "$tmpdir"` 353 | case $ls_ld_tmpdir in 354 | d????-?r-*) different_mode=700;; 355 | d????-?--*) different_mode=755;; 356 | *) false;; 357 | esac && 358 | $mkdirprog -m$different_mode -p -- "$tmpdir" && { 359 | ls_ld_tmpdir_1=`ls -ld "$tmpdir"` 360 | test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1" 361 | } 362 | } 363 | then posix_mkdir=: 364 | fi 365 | rmdir "$tmpdir/d" "$tmpdir" 366 | else 367 | # Remove any dirs left behind by ancient mkdir implementations. 368 | rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null 369 | fi 370 | trap '' 0;; 371 | esac;; 372 | esac 373 | 374 | if 375 | $posix_mkdir && ( 376 | umask $mkdir_umask && 377 | $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir" 378 | ) 379 | then : 380 | else 381 | 382 | # The umask is ridiculous, or mkdir does not conform to POSIX, 383 | # or it failed possibly due to a race condition. Create the 384 | # directory the slow way, step by step, checking for races as we go. 385 | 386 | case $dstdir in 387 | /*) prefix='/';; 388 | -*) prefix='./';; 389 | *) prefix='';; 390 | esac 391 | 392 | eval "$initialize_posix_glob" 393 | 394 | oIFS=$IFS 395 | IFS=/ 396 | $posix_glob set -f 397 | set fnord $dstdir 398 | shift 399 | $posix_glob set +f 400 | IFS=$oIFS 401 | 402 | prefixes= 403 | 404 | for d 405 | do 406 | test -z "$d" && continue 407 | 408 | prefix=$prefix$d 409 | if test -d "$prefix"; then 410 | prefixes= 411 | else 412 | if $posix_mkdir; then 413 | (umask=$mkdir_umask && 414 | $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break 415 | # Don't fail if two instances are running concurrently. 416 | test -d "$prefix" || exit 1 417 | else 418 | case $prefix in 419 | *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;; 420 | *) qprefix=$prefix;; 421 | esac 422 | prefixes="$prefixes '$qprefix'" 423 | fi 424 | fi 425 | prefix=$prefix/ 426 | done 427 | 428 | if test -n "$prefixes"; then 429 | # Don't fail if two instances are running concurrently. 430 | (umask $mkdir_umask && 431 | eval "\$doit_exec \$mkdirprog $prefixes") || 432 | test -d "$dstdir" || exit 1 433 | obsolete_mkdir_used=true 434 | fi 435 | fi 436 | fi 437 | 438 | if test -n "$dir_arg"; then 439 | { test -z "$chowncmd" || $doit $chowncmd "$dst"; } && 440 | { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } && 441 | { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false || 442 | test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1 443 | else 444 | 445 | # Make a couple of temp file names in the proper directory. 446 | dsttmp=$dstdir/_inst.$$_ 447 | rmtmp=$dstdir/_rm.$$_ 448 | 449 | # Trap to clean up those temp files at exit. 450 | trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0 451 | 452 | # Copy the file name to the temp name. 453 | (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") && 454 | 455 | # and set any options; do chmod last to preserve setuid bits. 456 | # 457 | # If any of these fail, we abort the whole thing. If we want to 458 | # ignore errors from any of these, just make sure not to ignore 459 | # errors from the above "$doit $cpprog $src $dsttmp" command. 460 | # 461 | { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } && 462 | { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } && 463 | { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } && 464 | { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } && 465 | 466 | # If -C, don't bother to copy if it wouldn't change the file. 467 | if $copy_on_change && 468 | old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` && 469 | new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` && 470 | 471 | eval "$initialize_posix_glob" && 472 | $posix_glob set -f && 473 | set X $old && old=:$2:$4:$5:$6 && 474 | set X $new && new=:$2:$4:$5:$6 && 475 | $posix_glob set +f && 476 | 477 | test "$old" = "$new" && 478 | $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1 479 | then 480 | rm -f "$dsttmp" 481 | else 482 | # Rename the file to the real destination. 483 | $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null || 484 | 485 | # The rename failed, perhaps because mv can't rename something else 486 | # to itself, or perhaps because mv is so ancient that it does not 487 | # support -f. 488 | { 489 | # Now remove or move aside any old file at destination location. 490 | # We try this two ways since rm can't unlink itself on some 491 | # systems and the destination file might be busy for other 492 | # reasons. In this case, the final cleanup might fail but the new 493 | # file should still install successfully. 494 | { 495 | test ! -f "$dst" || 496 | $doit $rmcmd -f "$dst" 2>/dev/null || 497 | { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null && 498 | { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; } 499 | } || 500 | { echo "$0: cannot unlink or rename $dst" >&2 501 | (exit 1); exit 1 502 | } 503 | } && 504 | 505 | # Now rename the file to the real destination. 506 | $doit $mvcmd "$dsttmp" "$dst" 507 | } 508 | fi || exit 1 509 | 510 | trap '' 0 511 | fi 512 | done 513 | 514 | # Local variables: 515 | # eval: (add-hook 'write-file-hooks 'time-stamp) 516 | # time-stamp-start: "scriptversion=" 517 | # time-stamp-format: "%:y-%02m-%02d.%02H" 518 | # time-stamp-end: "$" 519 | # End: 520 | --------------------------------------------------------------------------------