I am trying to solve the TSP (Traveling Salesman Problem) using the rbga.bin from the genealg package. I have matrix that stores the distances between the cities
like this:
[,1] [,2] [,3] [,4]
[1,] 0 2 10 4
[2,] 0 0 12 12
[3,] 0 0 0 5
[4,] 0 0 0 0
but I'm not able to code a proper evaluation function (even though I already saw some examples in documentation and on the web). I know a chromosome will be passed as a parameter to the evaluation function, but I don't know what operations to do to return a proper value.
Basically, you are asking how to evaluate the length of a path given the endpoints on that path and a distance matrix (for path 1-3-2-4, you want d13+d32+d24+d41). You can do this with matrix indexing and the sum function. Let's consider your distance matrix and solution 1-3-2-4 (since the TSP is typically posed in a symmetric form, I've made it symmetric):
(d <- matrix(c(0, 2, 10, 4, 2, 0, 12, 12, 10, 12, 0, 5, 4, 12, 5, 0), nrow=4))
# [,1] [,2] [,3] [,4]
# [1,] 0 2 10 4
# [2,] 2 0 12 12
# [3,] 10 12 0 5
# [4,] 4 12 5 0
sln <- c(1, 3, 2, 4)
Now you can grab matrix indexes from your solution and pull the distances, summing them for your final evaluation:
(idx <- cbind(sln, c(tail(sln, -1), sln[1])))
# [1,] 1 3
# [2,] 3 2
# [3,] 2 4
# [4,] 4 1
d[idx]
# [1] 10 12 12 4
sum(d[idx])
# [1] 38
Related
For a matrix of pairwise distances pdm (symmetric), where each row/column represents a point, and a vector of distances r, I will do th following for each point
# some small toy data
# note. real data is bigger, e.g. ~15k points.
pdm <- matrix(data = c(0, 4, 3,
4, 0, 2,
3, 2, 0),
nrow = 3, ncol = 3)
r <- seq(0, 5, .5)
length(r)
#> [1] 11
# index m correspondens to order of points.
m <- c(1, 2, 3)
# change format
pdml <- as.list(as.data.frame(pdm))
# ---- 1
# procedure for first point (1)
a <- list()
for(i in seq_along(r)) {
a[[i]] <- ifelse(0 < pdml[[1]] & pdml[[1]] <= r[i], 1, 0)
a[[i]] <- which(a[[i]] != 0)
# if-statement is needed since which() produces annoying integer(0) entries
if(identical(a[[i]], integer(0))) a[[i]] <- 0
a[[i]] <- sum(m[1] * m[a[[i]]])
}
# change format
do.call(rbind, a)
#> [,1]
#> [1,] 0
#> [2,] 0
#> [3,] 0
#> [4,] 0
#> [5,] 0
#> [6,] 0
#> [7,] 3
#> [8,] 3
#> [9,] 5
#> [10,] 5
#> [11,] 5
# ---- 2
# procedure for second point (2),
# ... adaption: pdml[[2]] and m[2]
Created on 2022-08-09 by the reprex package (v2.0.1)
Desired Output
After the calculation is done, I would like to calc. the average for each distance $r_i$ across all points.
Can somebody please provide a solution to extend my approach to all points or by showing an alternative, which cerntainly is more efficient? Also, any recommendation on how to improve my question is much appreciated.
Note, if it makes things easier, it is, of course, also an option to use the upper/lower half of pdm only.
If you precalculate the possible products you want to sum with tcrossprod(m),
you can simplify the calculation to a couple of matrix operations:
# Input data
m <- c(1, 2, 3)
d <- matrix(
data = c(
0, 4, 3,
4, 0, 2,
3, 2, 0
),
nrow = 3,
ncol = 3
)
r <- seq(0, 5) # Reduced for simplicity
# Possible summands
v <- tcrossprod(m) * (d != 0)
v
#> [,1] [,2] [,3]
#> [1,] 0 2 3
#> [2,] 2 0 6
#> [3,] 3 6 0
# The calculation
a <- sapply(r, \(r) colSums(v * (d <= r)))
a
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] 0 0 0 3 5 5
#> [2,] 0 0 6 6 8 8
#> [3,] 0 0 6 9 9 9
And since you said you then wanted the mean for each distance, over points:
colMeans(a)
#> [1] 0.000000 0.000000 4.000000 6.000000 7.333333 7.333333
A slightly more obscure but potentially faster way to find a would be
with 3-d arrays:
colSums(outer(v, rep(1, length(r))) * outer(d, r, `<=`))
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] 0 0 0 3 5 5
#> [2,] 0 0 6 6 8 8
#> [3,] 0 0 6 9 9 9
I'm brushing up on my linear algebra skills. Since my notebook is getting messy I'm trying to create my matrices in R. It is my hope that then I'll manage to avoid random errors.
I try to create a matrix with three rows and six columns:
matrix(
c(2,2,1,1,0,0),
c(1,3,2,0,1,0),
c(1,3,6,0,0,1),
nrow=3,
ncol=6)
I then get an error message stating that:
Error in matrix(c(2, 2, 1, 1, 0, 0), c(1, 3, 2, 0, 1, 0), c(1, 3, 6, 0, :
'dimnames' must be a list
I'm not sure I understand the hickup. I have specified my three rows and there's nothing in the help section claiming a need for naming anything at all?
It doesn't say "dimnames must be named”, it says "'dimnames' must be a list". It happens because you provide three c() objects in arguments, and the function expects only the first as an input data. Just wrap in one c():
matrix(
c( c(2,2,1,1,0,0),
c(1,3,2,0,1,0),
c(1,3,6,0,0,1)
),
nrow=3,
ncol=6)
Or put all numbers in a single c() from the very beginning. And you actually don't need to indicate both nrow and ncol, one is enough:
matrix(
c(2,2,1,1,0,0,
1,3,2,0,1,0,
1,3,6,0,0,1),
nrow=3)
An easy way to create matrices is to just bind your vectors:
rbind(
c(2,2,1,1,0,0),
c(1,3,2,0,1,0),
c(1,3,6,0,0,1))
Use rbind to row-bind a series of vectors, or feed a single vector to the matrix function. Note that if you choose option 2, you need to set byrow=TRUE because matrix is column major by default.
rbind(c(2,2,1,1,0,0),
c(1,3,2,0,1,0),
c(1,3,6,0,0,1))
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] 2 2 1 1 0 0
#> [2,] 1 3 2 0 1 0
#> [3,] 1 3 6 0 0 1
matrix(
c(2,2,1,1,0,0,
1,3,2,0,1,0,
1,3,6,0,0,1),
nrow=3,
ncol=6,
byrow=TRUE)
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] 2 2 1 1 0 0
#> [2,] 1 3 2 0 1 0
#> [3,] 1 3 6 0 0 1
I have two arrays.
Using numpy.append we can merge two arrays.
How can we do same thing in R?
merge can not do that.
Python Output/Example:
a=np.array([1,2,3,4,5,5])
b=np.array([0,0,0,0,0,0])
np.append(a,b)
array([1, 2, 3, 4, 5, 5, 0, 0, 0, 0, 0, 0]) # this is what I want
x<-c(mat , (0.0) * (l - length(demeaned)))
mat is matrix (size is 20)
l - length(demeaned) is 10
i want at the end 30 size
The c-function concatenates its arguments. A vector can be a concatenation of numbers or of other verctors:
a = c(1,2,3,4,5,5)
b = c(0,0,0,0,0,0)
c(a,b)
[1] 1 2 3 4 5 5 0 0 0 0 0 0
At least for one-dimensional arrays like in your python-example this is equivalent to np.append
Adding to the previous answer, you can use rbind or cbind to create two-dimensional arrays (matrices) from simple arrays (vectors):
cbind(a,b)
# output
a b
[1,] 1 0
[2,] 2 0
[3,] 3 0
[4,] 4 0
[5,] 5 0
[6,] 5 0
or
rbind(a,b)
# output
[,1] [,2] [,3] [,4] [,5] [,6]
a 1 2 3 4 5 5
b 0 0 0 0 0 0
If you want to convert it back to vector, use as.vector. This
as.vector(rbind(a,b))
will give you a joined vector with alternating elements.
Also, note that c can flatten lists if you use the recursive=TRUE argument:
a <- list(1,list(1,2,list(3,4)))
b <- 10
c(a,b, recursive = TRUE)
# output
[1] 1 1 2 3 4 10
Finally, you can use rep to generate sequences of repeating numbers:
rep(0,10)
I have a sample matrix like
5 4 3
2 6 8
1 9 7
and I want output like
max(5*6,5*8,5*9,5*7) // i!=j condition
max(4*2,4*8,4*1,4*7)
max(3*2,3*6,3*1,3*9)
And so on...
This maximum values obtained after computation should be in matrix form. I need to generalize it, therefore I need a generic code.
This gets the job done but is a pretty unimaginative solution, in that it just loops through the rows and columns performing the requested calculation instead of doing anything vectorized.
sapply(1:ncol(m), function(j) sapply(1:nrow(m), function(i) max(m[i,j]*m[-i,-j])))
# [,1] [,2] [,3]
# [1,] 45 32 27
# [2,] 18 42 72
# [3,] 8 72 42
Data:
(m <- matrix(c(5, 2, 1, 4, 6, 9, 3, 8, 7), nrow=3))
# [,1] [,2] [,3]
# [1,] 5 4 3
# [2,] 2 6 8
# [3,] 1 9 7
I have the matrix
m <- matrix(c(1, 0, 3, 4, 0, 6), 3)
I need to filter out rows where both columns have a value of 0 in effect returning the matrix:
m <- matrix(c(1, 3, 4, 6), 3)
I have tried
m[m[, 1] > 0 & m[, 2] > 0]
but this returns a vector instead of a matrix stripped of rows with only 0. This should be simple but I am stuck.
Thanks,
-Elizabeth
In case you had many columns
m
[,1] [,2]
[1,] 1 4
[2,] 0 0
[3,] 3 6
m^2
[,1] [,2]
[1,] 1 16
[2,] 0 0
[3,] 9 36
rowSums(m^2)
[1] 17 0 45
m[rowSums(m^2)>0,]
[,1] [,2]
[1,] 1 4
[2,] 3 6
You are just missing a "," in your own solution.
Use
m[m[,1]>0 & m[,2]>0,]
and it will work:
> m[m[,1]>0 & m[,2]>0,]
[,1] [,2]
[1,] 1 4
[2,] 3 6