Related
This question already has answers here:
How to add a vector to each column in a matrix in R?
(2 answers)
Closed 5 months ago.
How can I do this without the first replicate using recycling or matrix multiplication?
replicate(5, c(-74.04456199608506, 40.68923184725649)) + replicate(5, rnorm(2))
You could just use +, therefore using recycling:
replicate(5, rnorm(2)) + c(-74.04456199608506, 40.68923184725649)
output
[,1] [,2] [,3] [,4] [,5]
[1,] -74.30676 -75.55923 -74.57547 -73.35665 -75.33159
[2,] 39.11709 39.08770 39.22748 42.78934 41.47697
You could use sweep():
x <- replicate(5, rnorm(2))
sweep(x, 1, c(-74.04456199608506, 40.68923184725649), FUN = `+`)
Results check:
identical(replicate(5, c(-74.04456199608506, 40.68923184725649)) + x,
sweep(x, 1, c(-74.04456199608506, 40.68923184725649), FUN = `+`))
[1] TRUE
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
I'm experimenting with the vctrs package. My actual use-case is in relevant aspects similar to the rational class implemented in the helpful S3 vectors article on the vctrs homepage, in that it uses rcrd for paired data. I'll use that for my reprex for clarity. (EDIT: I am not, however, specifically interested in rationals.) Let me paste the relevant parts first:
library(vctrs)
library(zeallot)
new_rational <- function(n = integer(), d = integer()) {
vec_assert(n, ptype = integer())
vec_assert(d, ptype = integer())
new_rcrd(list(n = n, d = d), class = "vctrs_rational")
}
rational <- function(n, d) {
c(n, d) %<-% vec_cast_common(n, d, .to = integer())
c(n, d) %<-% vec_recycle_common(n, d)
new_rational(n, d)
}
format.vctrs_rational <- function(x, ...) {
n <- field(x, "n")
d <- field(x, "d")
out <- paste0(n, "/", d)
out[is.na(n) | is.na(d)] <- NA
out
}
vec_ptype_abbr.vctrs_rational <- function(x, ...) "rtnl"
vec_ptype_full.vctrs_rational <- function(x, ...) "rational"
An example of using this:
(x <- rational(1, 1:15))
#> <rational[15]>
#> [1] 1/1 1/2 1/3 1/4 1/5 1/6 1/7 1/8 1/9 1/10 1/11 1/12 1/13 1/14 1/15
My problem arises when trying to use a class like this in a matrix:
matrix(x, ncol = 5, nrow = 3)
#> Warning in matrix(x, ncol = 5, nrow = 3): data length [2] is not a sub-multiple
#> or multiple of the number of rows [3]
#> [,1] [,2] [,3] [,4] [,5]
#> [1,] Integer,15 Integer,15 Integer,15 Integer,15 Integer,15
#> [2,] Integer,15 Integer,15 Integer,15 Integer,15 Integer,15
#> [3,] Integer,15 Integer,15 Integer,15 Integer,15 Integer,15
Created on 2020-06-05 by the reprex package (v0.3.0)
I was hoping to get a 3-by-5 matrix with each cell containing one value from x, as would have happened if x had been a "normal" vector. Instead, I get a 3-by-5 matrix of lists, where vctrs tries to make alternating rows contain n and d values, respectively.
My question, therefore, is is it possible to get vctrs to work with matrices in the "expected" manner for a situation like this, and if so, how? By experimenting, I got the sense that this might have to do with implementing dim.rational and `dim<-.rational`, but I couldn't make it work.
EDIT: If the desired matrix is not clear (as suggested in the comments), I would like a matrix object somewhat akin to the following, which I've edited by hand:
(m <- matrix(x, ncol = 5, nrow = 3))
#> <rational[15]>
#> [,1] [,2] [,3] [,4] [,5]
#> [1,] 1/1 1/4 1/7 1/10 1/13
#> [2,] 1/2 1/5 1/8 1/11 1/14
#> [3,] 1/3 1/6 1/9 1/12 1/15
Such that normal matrix operations would work on m, e.g.
m[1,]
#> <rational[5]>
#> 1/1 1/4 1/7 1/10 1/13
The whole design of the rational class seems built on preserving its type safety, and hiding implementation from users, which I can see would be necessary to get it to work consistently, but this means that you can't expect it to play nicely with R's default S3 methods.
The help file for vctrs specifically says
dims(), dims<-, dimnames(), dimnames<-, levels(), and levels<- methods throw errors.
This suggests that the authors of vctrs didn't think it was a great base on which to build matrix methods.
In any case, I wouldn't be in such a hurry to try to get it into a matrix, since you can't do anything with it once it's there: there are no arithmetic methods available to you:
x + 2
#> Error: <rational> + <double> is not permitted
#> Run `rlang::last_error()` to see where the error occurred.
x * 2
#> Error: <rational> * <double> is not permitted
#> Run `rlang::last_error()` to see where the error occurred.
x + x
#> Error: <rational> + <rational> is not permitted
#> Run `rlang::last_error()` to see where the error occurred.
So you would need to define the arithmetic methods first. Before you even do that, you need $ accessors for the numerators and denominators, an is.rational function to check the type before attempting arithmetic, a function to find the greatest common denominator, and a function to simplify your rationals based on it.
`$.vctrs_rational` <- function(vec, symb) unclass(vec)[[as.character(symb)]]
is.rational <- function(num) class(num)[1] == "vctrs_rational"
gcd <- function(x, y) ifelse(x %% y, gcd(y, x %% y), y)
simplify <- function(num) {
common <- gcd(num$n, num$d)
rational(num$n / common, num$d/common)
}
So now you can do
x$n
#> [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
x$d
#> [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
is.rational(x)
#> [1] TRUE
And now write the arithmetic functions. For example, here is an implementation of basic arithmetic to cover numeric and rational types:
Ops.vctrs_rational <- function(vec, num)
{
if(!is.rational(vec)) {tmp <- vec; vec <- num; num <- tmp; }
if(.Generic == '*'){
if(is.rational(num)) return(simplify(rational(vec$n * num$n, vec$d * num$d)))
else return(simplify(rational(vec$n * 2, vec$d)))
}
else if (.Generic == '/'){
if(is.rational(num)) return(vec * rational(num$d, num$n))
else return(vec * rational(1, num))
}
else if (.Generic == '+'){
if(is.rational(num)){
new_n <- vec$n * (vec$d * num$d)/vec$d + num$n * (vec$d * num$d)/num$d
return(simplify(rational(new_n, vec$d * num$d)))
}
else return(simplify(rational(num * vec$d + vec$n, vec$d)))
}
else if (.Generic == '-'){
if(is.rational(num)) return(vec + rational(-num$n, num$d))
else return(vec + (-num))
}
else if (.Generic == '^'){
if(is.rational(num) | num < 0) stop("fractional and negative powers not supported")
return(simplify(rational(vec$n ^ num, vec$d ^ num)))
}
}
This now allows you to do, for example:
x * 3
#> <rational[15]>
#> [1] 3/1 3/2 1/1 3/4 3/5 1/2 3/7 3/8 1/3 3/10 3/11 1/4 3/13 3/14 1/5
x + x
#> <rational[15]>
#> [1] 2/1 1/1 2/3 1/2 2/5 1/3 2/7 1/4 2/9 1/5 2/11 1/6 2/13 1/7 2/15
(2 + x)^2 / (3 * x + 1)
#> <rational[15]>
#> [1] 3/1 25/8 49/15 27/8 121/35 169/48 25/7 289/80
#> [9] 361/99 147/40 529/143 625/168 243/65 841/224 961/255
Trying to use matrix() itself directly is probably not going to work, since matrix works by converting to a base vector and then calling C code. This strips out class information.
That means you need to define a separate rational_matrix class, which in turn would benefit from a supporting rational_vector class. We can then define specific format and print methods:
as.vector.vctrs_rational <- function(x, ...) {
n <- x$n/x$d
attr(n, "denom") <- x$d
attr(n, "numerator") <- x$n
class(n) <- "rational_attr"
n
}
rational_matrix <- function(data, nrow = 1, ncol = 1,
byrow = FALSE, dimnames = NULL){
d <- as.vector(data)
m <- .Internal(matrix(d, nrow, ncol, byrow, dimnames, missing(nrow),
missing(ncol)))
m_dim <- dim(m)
attributes(m) <- attributes(d)
dim(m) <- rev(m_dim)
class(m) <- c("rational_matrix", "matrix")
m
}
format.rational_matrix <- function(x) {
return(paste0(attr(x, "numerator"), "/", attr(x, "denom")))
}
print.rational_matrix <- function(x)
{
print(matrix(format(x), nrow = dim(x)[2]), quote = FALSE)
}
Finally, you need to overwrite matrix() to make it an S3 method, being sure you first copy the function as matrix.default
matrix.default <- matrix
matrix <- function(data = NA, ...) UseMethod("matrix")
matrix.vctrs_rational <- function(data, ...) rational_matrix(data, ...)
So now you can do:
matrix(x, nrow = 5)
#> [,1] [,2] [,3] [,4] [,5]
#> [1,] 1/1 1/4 1/7 1/10 1/13
#> [2,] 1/2 1/5 1/8 1/11 1/14
#> [3,] 1/3 1/6 1/9 1/12 1/15
rational_matrix(x + 5, nrow = 3)
#> [,1] [,2] [,3] [,4] [,5]
#> [1,] 6/1 21/4 36/7 51/10 66/13
#> [2,] 11/2 26/5 41/8 56/11 71/14
#> [3,] 16/3 31/6 46/9 61/12 76/15
rational_matrix(x + x, nrow = 5)
#> [,1] [,2] [,3]
#> [1,] 2/1 1/3 2/11
#> [2,] 1/1 2/7 1/6
#> [3,] 2/3 1/4 2/13
#> [4,] 1/2 2/9 1/7
#> [5,] 2/5 1/5 2/15
However, to get this to work we had to add extra classes with attributes anyway, so my feeling is that if you want a rational class that works with matrices etc, you should do it in native S3 or one of the other object-oriented approaches available in R rather than using the vctrs package.
It's also worth saying that the above class is far from production-ready, since you would need to add in methods to test equality / inequality, methods to describe the matrix operations, an ability to convert to decimal, plotting methods, etc.
In R I have two matrices X and Z and I would like a
matrix W such that the row (i) of W contains row (i) of X interacted with row (i) of Z.
W(i) = X(i1)Z(i1) ... X(iJ)Z(i1) ... X(i1)Z(iK) ... X(iJ)Z(iK)
Here is an example in small scale doing what I want:
set.seed(1)
n <- 3
K <- 2
J <- 3
X <- matrix(rnorm(J*n),ncol=J)
Z <- matrix(rnorm(K*n),ncol=K)
W <- matrix(NA,nrow=n,ncol=K*J)
for (i in 1:n)
{
for (k in 1:K)
{
for (j in 1:J)
{
W[i,j + J*(k-1)] <- X[i,j] * Z[i,k]
}
}
}
Is there a clever way to do that?
I ended up doing
X[,sort(rep(1:J,K))] * Z[,rep(1:K,J)]
For this example, you can do
cbind(X * Z[, 1], X * Z[, 2])
# [,1] [,2] [,3] [,4] [,5] [,6]
#[1,] 0.1913117 -0.4871802 -0.1488552 0.3891785 -0.9910532 -0.3028107
#[2,] 0.2776285 0.4981436 1.1161854 -0.4067148 -0.7297608 -1.6351676
#[3,] -0.3257642 -0.3198541 0.2244645 -0.9400245 -0.9229703 0.6477142
Or more generally we can use apply for many more columns.
W[] <- apply(Z, 2, function(x) X * x)
which gives the same output as W which we get after running your loop.
W
# [,1] [,2] [,3] [,4] [,5] [,6]
#[1,] 0.1913117 -0.4871802 -0.1488552 0.3891785 -0.9910532 -0.3028107
#[2,] 0.2776285 0.4981436 1.1161854 -0.4067148 -0.7297608 -1.6351676
#[3,] -0.3257642 -0.3198541 0.2244645 -0.9400245 -0.9229703 0.6477142
I want to generate a random matrix which should be symmetric.
I have tried this:
matrix(sample(0:1, 25, TRUE), 5, 5)
but it is not necessarily symmetric.
How can I do that?
Another quite interesting opportunity is based on the following mathematical fact: if A is some matrix, then A multiplied by its transpose is always symmetric.
> A <- matrix(runif(25), 5, 5)
> A %*% t(A)
[,1] [,2] [,3] [,4] [,5]
[1,] 1.727769 1.0337816 1.2195505 1.4661507 1.1041355
[2,] 1.033782 1.0037048 0.7368944 0.9073632 0.7643080
[3,] 1.219551 0.7368944 1.8383986 1.3309980 0.9867812
[4,] 1.466151 0.9073632 1.3309980 1.3845322 1.0034140
[5,] 1.104135 0.7643080 0.9867812 1.0034140 0.9376534
Try this from the Matrix package
library(Matrix)
x<-Matrix(rnorm(9),3)
x
3 x 3 Matrix of class "dgeMatrix"
[,1] [,2] [,3]
[1,] -0.9873338 0.8965887 -0.6041742
[2,] -0.3729662 -0.5882091 -0.2383262
[3,] 2.1263985 -0.3550972 0.1067264
X<-forceSymmetric(x)
X
3 x 3 Matrix of class "dsyMatrix"
[,1] [,2] [,3]
[1,] -0.9873338 0.8965887 -0.6041742
[2,] 0.8965887 -0.5882091 -0.2383262
[3,] -0.6041742 -0.2383262 0.1067264
If you don't want to use a package:
n=3
x <- matrix(rnorm(n*n), n)
ind <- lower.tri(x)
x[ind] <- t(x)[ind]
x
I like this one:
n <- 3
aux <- matrix(NA, nrow = n, ncol = n)
for(i in c(1:n)){
for(j in c(i:n)){
aux[i,j] <- sample(c(1:n), 1)
aux[j,i] <- aux[i,j]
}
}