I would like to take an arma::vec object and reshape it to an arma::cube object.
For example:
vec param(mm*n*g);
param.randn();
cube LL = reshape(param,mm,n,g); // this line doesn't work
The easiest way I can get this to work is:
paramtemp = as<NumericVector>(wrap(param));
cube LL(paramtemp.begin(),mm,n,g);
But surely there is a more elegant way?
Many Armadillo classes provide constructors which take an argument that is a pointer to another memory location; generally this will be a begin iterator of another object. For example,
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
// [[Rcpp::export]]
arma::cube to_cube(int x, int y, int z) {
arma::vec v(x * y * z);
v.randn();
arma::cube res((const double*)v.begin(), x, y, z);
return res;
}
/***R
to_cube(3, 3, 3)
# , , 1
#
# [,1] [,2] [,3]
# [1,] -0.8052190 0.5206867 0.4562287
# [2,] 0.6407149 0.8247035 -0.2375103
# [3,] -0.2766542 0.0527188 -1.2807390
#
# , , 2
#
# [,1] [,2] [,3]
# [1,] -0.49995982 0.7240956 0.66634699
# [2,] 0.06367092 -0.7991327 -0.36003560
# [3,] -0.90958952 -0.4431064 0.05952237
#
# , , 3
#
# [,1] [,2] [,3]
# [1,] 0.457159 1.6725911 -0.9299367
# [2,] 1.205733 0.6185083 0.3805266
# [3,] 0.545668 -0.4356577 -0.9111175
*/
I'm not sure if the cast to const double* is strictly necessary, but it is there to distinguish between the following two constructors,
cube(const ptr_aux_mem, n_rows, n_cols, n_slices)
cube(ptr_aux_mem, n_rows, n_cols, n_slices, copy_aux_mem = true, strict = false)
where the first (which is the intention above) is a read-only copy.
Related
Under R I developed this script:
Sphere_1 = function (x1,x2) return(x1^2+x2^2) #sphere function / objective function
Initial_search_domain_function <- function(N,p,MIN_t_x,MAX_t_x,MIN_t_y,MAX_t_y , Objfun=custom_fun ) {
x1 <- runif(N, min = MIN_t_x, max = MAX_t_x) # Create x vector (same as in Example 1 & 2)
y1 <- runif(N, min = MIN_t_y, max = MAX_t_y) # Create y vector (same as in Example 2)
m <- outer(x1, y1, Objfun) #matrix of minimum objective values
print("matrix of objective function")
#print(m)
p_minimum_value <- sort(m)[1:p] # search p minimum values of the objective function 'Objfun' within m
X_Y_indices=which(relist(m %in% p_minimum_value, m), arr.ind = TRUE) # retrieve their corresponding row/cloumn at m
#print(X_Y_indices)
print("list of respective positions")
v1=x1[X_Y_indices[,1]] # retrieve their corresponding x-coordinate from x1 list
v2=y1[X_Y_indices[,2]] # retrieve their corresponding y-coordinate from y1 list
respective_positions=rbind(v1,v2) # store those coordinate in a matrix
respective_positions=rbind(respective_positions, `fun(x, y)` = apply(respective_positions, 2, function(x) Objfun(x[1], x[2])))
# compute the objective function for each row
rownames(respective_positions)=c("x:","y:","obj-val")
print(respective_positions)
return(respective_positions)
}
Example of output:
Initial_search_domain_function(40,5,-4.5,4.5,-4.5,4.5, Sphere_1 ) ;
[1] "matrix of objective function"
[1] "list of respective positions"
[,1] [,2] [,3] [,4] [,5]
x: 0.2904639 0.29046393 0.29046393 -0.40499210 0.29046393
y: 0.2894644 0.07744045 0.05273694 0.05273694 0.11452047
obj-val 0.1681589 0.09036632 0.08715048 0.16679979 0.09748423
I'm wanting a way such that the code not only work for a two-variables function f(x,y) , but also for n-dimensions function.
For example if n=3 I could get something like:
[1] "list of respective positions"
[,1] [,2] [,3] [,4] [,5]
x: 0.2904639 0.29046393 0.29046393 -0.40499210 0.29046393
y: 0.2894644 0.07744045 0.05273694 0.05273694 0.11452047
z: 0.2904639 0.27046393 0.50046393 -0.90499210 0.129046393
obj-val 0.1681589 0.09036632 0.08715048 0.16679979 0.09748423
with n-dimensional function like:
Sphere = function (x) return(sum(x^2)) #sphere function / objective function
The main problem is that I don't know how to compute Cartesian products for n-sets with their respective objective function values f (X) where X is n-dimensional.
Here is an p-dimensional function. Note that this is just an exact replica of your code, only made to work for p-dimensions. Notice that I gave it a seed argument in order for one to make comparisons:
Sphere_1_pdim = function (x) return(sum(x^2))
Initial_search_domain_function_pdim <- function(N, p, MIN, MAX, Objfun, seed = NULL) {
stopifnot(length(MIN) == length(MAX),length(N) == 1,length(p) == 1)
dims <- numeric(length(MIN)) + N
set.seed(seed)
X <- Map(runif,N,MIN,MAX)
names(X) <- paste0("X",seq_along(X),":")
m <- array(apply(expand.grid(X),1,Objfun), dims)
p_minimum_value <- sort(m)[1:p]
indices <-which(array(m %in% p_minimum_value, dim(m)), arr.ind = TRUE)
t(cbind(mapply("[",X,data.frame(indices)),"obj-val:" = m[indices]))
}
Initial_search_domain_function_pdim(40, 5, c(-4.5,-4.5,-4.5), c(4.5,4.5,4.5), Sphere_1_pdim, 0)
[,1] [,2] [,3] [,4] [,5]
X1: -0.02070682 -0.02070682 -0.05812824 -0.02070682 -0.05812824
X2: -0.20142340 0.16770837 0.16770837 -0.19309277 -0.19309277
X3: -0.19693769 -0.19693769 -0.19693769 -0.19693769 -0.19693769
obj-val: 0.07978461 0.06733932 0.07028944 0.07649804 0.07944816
Your code output:
Initial_search_domain_function(40,5, -4.5, 4.5, -4.5, 4.5, Sphere_1, 0)
[,1] [,2] [,3] [,4] [,5]
x: -0.02070682 -0.02070682 -0.05812824 -0.02070682 -0.05812824
y: -0.20142340 0.16770837 0.16770837 -0.19309277 -0.19309277
obj-val 0.04100016 0.02855487 0.03150499 0.03771359 0.04066371
A function takes two sets of values from two vectors (alpha and beta). I need to place the values of the function output in a matrix with size alpha x beta. The function calculates power values. I appreciate your help. I need a matrix 5x5. I have attempted the following code so far:
alpha = c(0.01,0.05,0.10,0.20)
beta = c(0.50,0.60,0.70,0.80,0.90)
pwrmx <- matrix(data=NA, nrow=alpha, ncol=beta)
for (a in alpha){
for (b in beta){
pwr <- power.prop.test(n=NULL, p1=0.25, p2=0.4, sig.level = a, power = b)
print(pwr$n)
}
}
you were almost there, refer the comments:
alpha = c(0.01,0.05,0.10,0.20)
beta = c(0.50,0.60,0.70,0.80,0.90)
# nrow and ncol depends on the length of alpha and beta
pwrmx <- matrix(data=NA, nrow=length(alpha), ncol=length(beta))
# iterate over the length so that you can use it to assign back at the correct index in matrix
for (i in 1:length(alpha)){
for (j in 1:length(beta)){
# as you are interested in the number n from the power analysis
pwrmx[i,j] <- (power.prop.test(n=NULL, p1=0.25, p2=0.4, sig.level = alpha[i], power = beta[j]))$n
}
}
pwrmx
# . [,1] [,2] [,3] [,4] [,5]
#[1,] 129.38048 155.72219 186.60552 226.29474 287.6656
#[2,] 74.90845 95.24355 119.70057 151.86886 202.8095
#[3,] 52.75810 70.01993 91.18885 119.50901 165.1130
#[4,] 32.02629 45.74482 63.12283 87.00637 126.4575
No need of loops, you can create a function to perform the calculation
func <- function(x, y) power.prop.test(n=NULL, p1=0.25, p2=0.4, sig.level = x, power = y)$n
and then use outer and apply the function (func) on each combination of alpha and beta
outer(alpha, beta, Vectorize(func))
# [,1] [,2] [,3] [,4] [,5]
#[1,] 129.38048 155.72219 186.60552 226.29474 287.6656
#[2,] 74.90845 95.24355 119.70057 151.86886 202.8095
#[3,] 52.75810 70.01993 91.18885 119.50901 165.1130
#[4,] 32.02629 45.74482 63.12283 87.00637 126.4575
I was struggling with subsetting columns of a matrix of class arma::mat.
Let's say arma::mat X is given, and I tried to create a vector of indices IDX, in order to do X.cols(IDX). Especially, the index vector has every k-th integer from 1 to p (dimension of X). For example, one may be interested in every even columns IDX=[2,4,6,8, ...].
Based on this documentation, contiguous indices such as [0, 1, 2, ..., m-1] can be extracted easily using X.cols(0, m - 1) if m <= p. However, I couldn't find a good way to subset a matrix with the index vector IDX described above.
I wonder how I complete this code to give a desired output.
My "subset_armamat.cpp" file looks like
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
using namespace Rcpp;
using namespace arma;
// [[Rcpp::export]]
mat subset_armamat(mat X, int k){
uvec IDX = "every k-th integer from 0 to X.ncols";
return X.cols(IDX);
}
and R code to execute the defined function is
library("Rcpp")
sourceCpp("subset_armamat.cpp")
subset_armamat(matrix(1:10, 2, 5, byrow = T), 2)
This is expected to produce a 2-by-3 matrix as the following R code would give
> matrix(1:10, 2, 5, byrow = T)[,seq(1, 5, by = 2)]
[,1] [,2] [,3]
[1,] 1 3 5
[2,] 6 8 10
It would be very appreciated if you give any input.
p.s. I've tried to
generate a sequence vector seq(1,m) * 2 manually, but this does not work with X.cols().
or find an index using find(seq(1,p) % 2 == 0), but % operator does not work well between seq(1,p) and 2.
F. Privé's answer showed that you can in fact use a uvec to subset a matrix using .cols() even if its not a contiguous range, using the base R seq() function to generate the sequence. I will further demonstrate that you can generate the sequence using an Armadillo function; you can use arma::regspace() -- it "generate[s] a vector with regularly spaced elements" (Armadillo documentation source):
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
using namespace Rcpp;
using namespace arma;
// [[Rcpp::export]]
mat subset_armamat(mat X, int k) {
uvec IDX = regspace<uvec>(0, k, X.n_cols-1);
return X.cols(IDX);
}
As a comparison to calling R's seq() (where subset_armamatR() is the function from F. Privé's answer):
library("Rcpp")
sourceCpp("subset_armamat.cpp")
mat <- matrix(1:10, 2, 5, byrow = TRUE)
subset_armamat(mat, 2)
#> [,1] [,2] [,3]
#> [1,] 1 3 5
#> [2,] 6 8 10
subset_armamatR(mat, 2)
#> [,1] [,2] [,3]
#> [1,] 1 3 5
#> [2,] 6 8 10
library(microbenchmark)
microbenchmark(Rseq = subset_armamatR(mat, 2),
regspace = subset_armamat(mat, 2))
#> Unit: microseconds
#> expr min lq mean median uq max neval cld
#> Rseq 235.535 239.1615 291.1954 241.9850 248.6005 4704.467 100 a
#> regspace 14.221 15.0225 520.9235 15.8165 16.6740 50408.375 100 a
Update: Passing by reference
A comment from hbrerkere warrants some brief additional discussion. If you are calling this function from C++, you'll gain speed by changing mat subset_armamat(mat X, int k) to mat subset_armamat(const mat& X, int k). Passing by reference like this avoids an unnecessary copy, and when you do not intend to change an object passed by reference, you should use const. However, if you are calling this function from R, you cannot avoid a copy as arma::mat is not a native R type (see, for example, this answer by Dirk Eddelbuettel (the maintainer of both Rcpp and RcppArmadillo). Consider the following example:
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
// [[Rcpp::export]]
void reference_example(arma::mat& X) {
X(0, 0) = 42;
}
// [[Rcpp::export]]
void print_reference_example(arma::mat X) {
reference_example(X);
Rcpp::Rcout << X << "\n";
}
Then calling from R:
library("Rcpp")
sourceCpp("reference_example.cpp")
mat <- matrix(1:4, 2, 2)
mat
#> [,1] [,2]
#> [1,] 1 3
#> [2,] 2 4
reference_example(mat)
mat
#> [,1] [,2]
#> [1,] 1 3
#> [2,] 2 4
print_reference_example(mat)
#> 42.0000 3.0000
#> 2.0000 4.0000
mat
#> [,1] [,2]
#> [1,] 1 3
#> [2,] 2 4
This works:
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
using namespace Rcpp;
using namespace arma;
// [[Rcpp::export]]
mat subset_armamat(mat X, int k) {
// Obtain environment containing function
Rcpp::Environment base("package:base");
// Make function callable from C++
Rcpp::Function seq = base["seq"];
uvec IDX = as<uvec>(seq(0, X.n_cols, k));
return X.cols(IDX);
}
I just call R function base::seq() from Rcpp.
I'm working with a three-dimensional array in R that has dimensions determined by user arguments, and where the first dimension can be of length 1 or more.
Subsetting the array works fine if the first dimension is of length two or more:
Arr2 <- array(rnorm(2 * 4 * 7), dim = c(2, 4, 7))
Arr2[,,1]
But if the first dimension is of length one, the subset operator will return either a vector (if drop = TRUE) or a three-dimensional array (if drop = FALSE):
Arrrrgh <- array(rnorm(1 * 4 * 7), dim = c(1,4,7))
Arrrrgh[,,1]
Arrrrgh[,,1,drop=FALSE]
How can I subset this array along the third dimension, while preserving the first and second dimensions?
As you note, from ?"[" there are only two options to control the dimension, drop=TRUE (the default, which in this case will drop both the first and third dimensions) and drop=FALSE, which won't drop any dimension. Neither of these options returns the desired dimension of c(1, 4):
dim(Arrrrgh[,,1])
# NULL
dim(Arrrrgh[,,1,drop=FALSE])
# [1] 1 4 1
One way to address this would be to set the dimension yourself after the subsetting operation:
`dim<-`(Arrrrgh[,,1], dim(Arrrrgh)[1:2])
# [,1] [,2] [,3] [,4]
# [1,] 0.1548771 0.6833689 -0.7507798 1.271966
You could generalize this to a function that drops specified indices if they have a single value passed and doesn't drop any other indices:
extract.arr <- function(arr, ...) {
m <- match.call(expand.dots=FALSE)
missing <- sapply(m[["..."]], is.symbol)
dot.len <- sapply(m[["..."]], function(x) if (is.symbol(x)) 0 else length(eval(x)))
cdim <- dim(arr)
eff.dim <- ifelse(missing, cdim, dot.len)
`dim<-`(do.call("[", c(list(arr), m[["..."]])), eff.dim[eff.dim > 1 | missing])
}
extract.arr(Arrrrgh, ,,1)
# [,1] [,2] [,3] [,4]
# [1,] -0.8634659 1.031382 0.4290036 0.8359372
extract.arr(Arrrrgh, ,,1:2)
# , , 1
#
# [,1] [,2] [,3] [,4]
# [1,] -0.8634659 1.031382 0.4290036 0.8359372
#
# , , 2
#
# [,1] [,2] [,3] [,4]
# [1,] 0.6970842 0.1185803 0.3768951 -0.4577554
extract.arr(Arrrrgh, 1,1,)
# [1] -0.8634659 0.6970842 0.1580495 -1.6606119 -0.2749313 0.4810924 -1.1139392
Inside a function of type SEXP myfun(SEXP n, SEXP d) I allocate an (n, d)-matrix which contains the result of a function computed in C:
SEXP res = PROTECT(allocMatrix(REALSXP, n, d));
I would like to 'fill' this matrix (it can then be returned by myfun) and thus would like to convert it to an (n, d)-matrix in C (or pointer or so). How can this be done?
If res was a vector, I could do:
double *res_ = REAL(res);
and then walk through res_ with a for loop. However, when I use that for the above matrix, it loses its dimension, i.e., indexing via res_[i][j] for computing the result fails. Of course one could work with a vector and keep track of the row/col indices oneself, but ideally I would like to simply write res_[i][j]. Is this doable without significant amount of extra code?
The matrix is going to be stored as a vector internally, which should imply that [i][j] is meaningless in C. Here is an example from Writing R Extensions on how you would do this:
#include <R.h>
#include <Rinternals.h>
SEXP out(SEXP x, SEXP y)
{
R_len_t i, j, nx = length(x), ny = length(y);
double tmp, *rx = REAL(x), *ry = REAL(y), *rans;
SEXP ans;
PROTECT(ans = allocMatrix(REALSXP, nx, ny));
rans = REAL(ans);
for(i = 0; i < nx; i++) {
tmp = rx[i];
for(j = 0; j < ny; j++)
rans[i + nx*j] = tmp * ry[j];
}
UNPROTECT(1);
return(ans);
}
Speed if course very important, but I also like code clarity. The solution by BrodieG could be written as a much shorter RcppArmadillo function -- it really is just a single outer product:
#include <RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]
// [[Rcpp::export]]
arma::mat outCpp(arma::colvec x, arma::rowvec y) {
return x * y;
}
If we test this against Brodie's (renamed to outC()) we get his:
R> sourceCpp("/tmp/marius.cpp")
R> library(rbenchmark)
R> a <- as.numeric(1:3)
R> b <- as.numeric(1:4)
R> outC(a, b)
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 2 4 6 8
[3,] 3 6 9 12
R> outCpp(a, b)
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 2 4 6 8
[3,] 3 6 9 12
R> benchmark(outC(a,b), outCpp(a,b), replications=1e5)[,1:4]
test replications elapsed relative
1 outC(a, b) 100000 0.382 1.000
2 outCpp(a, b) 100000 0.484 1.267
R>
So running 100,000 replications takes 380 vs 480 msec.
That means for each call, the difference is one millionth of a second. I think I take for having a single line of code that is easier to read and maintain.