R: Different Ways to Name Matrices

Question

I am working with the R programming language.

In the "datasets" library in R, there is a data set called "eurodist" that contains the distance between each combination of cities :

library(datasets)

This data set can be then converted into a "matrix":

eurodist = as.matrix(eurodist)

                Athens Barcelona Brussels Calais Cherbourg Cologne Copenhagen Geneva Gibraltar Hamburg Hook of Holland Lisbon Lyons Madrid Marseilles Milan Munich Paris Rome Stockholm Vienna
Athens               0      3313     2963   3175      3339    2762       3276   2610      4485    2977            3030   4532  2753   3949       2865  2282   2179  3000  817      3927   1991
Barcelona         3313         0     1318   1326      1294    1498       2218    803      1172    2018            1490   1305   645    636        521  1014   1365  1033 1460      2868   1802
Brussels          2963      1318        0    204       583     206        966    677      2256     597             172   2084   690   1558       1011   925    747   285 1511      1616   1175
Calais            3175      1326      204      0       460     409       1136    747      2224     714             330   2052   739   1550       1059  1077    977   280 1662      1786   1381
Cherbourg         3339      1294      583    460         0     785       1545    853      2047    1115             731   1827   789   1347       1101  1209   1160   340 1794      2196   1588
Cologne           2762      1498      206    409       785       0        760   1662      2436     460             269   2290   714   1764       1035   911    583   465 1497      1403    937
Copenhagen        3276      2218      966   1136      1545     760          0   1418      3196     460             269   2971  1458   2498       1778  1537   1104  1176 2050       650   1455
Geneva            2610       803      677    747       853    1662       1418      0      1975    1118             895   1936   158   1439        425   328    591   513  995      2068   1019
Gibraltar         4485      1172     2256   2224      2047    2436       3196   1975         0    2897            2428    676  1817    698       1693  2185   2565  1971 2631      3886   2974
Hamburg           2977      2018      597    714      1115     460        460   1118      2897       0             550   2671  1159   2198       1479  1238    805   877 1751       949   1155
Hook of Holland   3030      1490      172    330       731     269        269    895      2428     550               0   2280   863   1730       1183  1098    851   457 1683      1500   1205
Lisbon            4532      1305     2084   2052      1827    2290       2971   1936       676    2671            2280      0  1178    668       1762  2250   2507  1799 2700      3231   2937
Lyons             2753       645      690    739       789     714       1458    158      1817    1159             863   1178     0   1281        320   328    724   471 1048      2108   1157
Madrid            3949       636     1558   1550      1347    1764       2498   1439       698    2198            1730    668  1281      0       1157  1724   2010  1273 2097      3188   2409
Marseilles        2865       521     1011   1059      1101    1035       1778    425      1693    1479            1183   1762   320   1157          0   618   1109   792 1011      2428   1363
Milan             2282      1014      925   1077      1209     911       1537    328      2185    1238            1098   2250   328   1724        618     0    331   856  586      2187    898
Munich            2179      1365      747    977      1160     583       1104    591      2565     805             851   2507   724   2010       1109   331      0   821  946      1754    428
Paris             3000      1033      285    280       340     465       1176    513      1971     877             457   1799   471   1273        792   856    821     0 1476      1827   1249
Rome               817      1460     1511   1662      1794    1497       2050    995      2631    1751            1683   2700  1048   2097       1011   586    946  1476    0      2707   1209
Stockholm         3927      2868     1616   1786      2196    1403        650   2068      3886     949            1500   3231  2108   3188       2428  2187   1754  1827 2707         0   2105
Vienna            1991      1802     1175   1381      1588     937       1455   1019      2974    1155            1205   2937  1157   2409       1363   898    428  1249 1209      2105      0

My Question: Suppose I have 6 cities and the Longitude/Latitude for each of these cities :

data_1 = data.frame(id = c(1,2,3), long = rnorm(3, -74, 1 ), lat = rnorm(3, 40, 1 ))
data_2 = data.frame(id = c(4,5,6), long = rnorm(3, -78, 1 ), lat = rnorm(3, 42, 1 ))
final_data = rbind(data_1, data_2)
final_data$names <- c("city_1", "city_2", "city_3", "city_4", "city_5", "city_6")

  id      long      lat  names
1  1 -75.28447 40.21079 city_1
2  2 -73.29385 40.09104 city_2
3  3 -75.12737 38.88355 city_3
4  4 -79.42325 42.61917 city_4
5  5 -77.82508 41.11707 city_5
6  6 -77.62831 39.94935 city_6

I can also make a similar matrix for these cities that contains the distance between each pair of cities:

library(geosphere)

N <- nrow(final_data) 

dists <- outer(seq_len(N), seq_len(N), function(a,b) {
    geosphere::distHaversine(final_data[a,2:3], final_data[b,2:3]) # Notes 1, 2
})

D <- as.matrix(dists)

         [,1]     [,2]     [,3]     [,4]     [,5]     [,6]
[1,]      0.0 169895.7 148361.1 437239.3 237056.7 201742.0
[2,] 169895.7      0.0 207068.8 584183.9 399577.9 369814.4
[3,] 148361.1 207068.8      0.0 551356.0 338698.3 245620.3
[4,] 437239.3 584183.9 551356.0      0.0 213326.6 332955.7
[5,] 237056.7 399577.9 338698.3 213326.6      0.0 131051.7
[6,] 201742.0 369814.4 245620.3 332955.7 131051.7      0.0

How can I make my matrix look the same way as the "eurodist" matrix?

I had thought of the following way to do this:

 colnames(dists) <- c("city_1", "city_2", "city_3", "city_4", "city_5", "city_6")

 rownames(dists) <- c("city_1", "city_2", "city_3", "city_4", "city_5", "city_6")

         city_1   city_2   city_3   city_4   city_5   city_6
city_1      0.0 169895.7 148361.1 437239.3 237056.7 201742.0
city_2 169895.7      0.0 207068.8 584183.9 399577.9 369814.4
city_3 148361.1 207068.8      0.0 551356.0 338698.3 245620.3
city_4 437239.3 584183.9 551356.0      0.0 213326.6 332955.7
city_5 237056.7 399577.9 338698.3 213326.6      0.0 131051.7
city_6 201742.0 369814.4 245620.3 332955.7 131051.7      0.0

In the end, I would like to use the above matrix as input for a customized Travelling Salesman Problem (R: Customizing the Travelling Salesman Problem) - e.g. Try to find the optimal path when you are forced to start at "city 4" and the third city should be "city 5":

D <- dists

transformMatrix <- function(fixed_points, D){
  
  if(length(fixed_points) == 0) return(D)
  
  p <- integer(nrow(D))
  pos <- match(names(fixed_points), colnames(D))
  p[fixed_points] <- pos 
  p[-fixed_points] <- sample(setdiff(seq_len(nrow(D)), pos))

  D[p, p]
}

fixed_points <- c(
  "city_4" = 1, "city_5" = 3
)

D_perm <- transformMatrix(fixed_points, D)

feasiblePopulation <- function(n, size, fixed_points){
  
  positions <- setdiff(seq_len(n), fixed_points)
  
  m <- matrix(0, size, n)
  if(length(fixed_points) > 0){
    
    m[, fixed_points] <- rep(fixed_points, each = size)
    
    for(i in seq_len(size))
      m[i, -fixed_points] <- sample(positions)
    
  } else {
    
    for(i in seq_len(size))
      m[i,] <- sample(positions)
  }
  
  m
}

mutation <- function(n, fixed_points){
  
  positions <- setdiff(seq_len(n), fixed_points)
  
  function(obj, parent){
    
    vec <- obj@population[parent,]
    if(length(positions) < 2) return(vec) 
    
    indices <- sample(positions, 2)
    replace(vec, indices, vec[rev(indices)])
  }
}

fitness <- function(tour, distMatrix) {
  
  tour <- c(tour, tour[1])
  route <- embed(tour, 2)[,2:1]
  1/sum(distMatrix[route])
}


popSize = 500

res <- ga(
  type = "permutation",
  fitness = fitness,
  distMatrix = D_perm,
  lower = 1,
  upper = nrow(D_perm),
  mutation = mutation(nrow(D_perm), fixed_points),
  crossover = gaperm_pmxCrossover,
  suggestions = feasiblePopulation(nrow(D_perm), popSize, fixed_points),
  popSize = popSize,
  maxiter = 5000,
  run = 500,
  pmutation = 0.2
)

colnames(D_perm)[res@solution[1,]]

This results in the following error:

Error in if (object@run >= run) break : 
  missing value where TRUE/FALSE needed
In addition: Warning messages:
1: In max(fitness) : no non-missing arguments to max; returning -Inf
2: In max(Fitness, na.rm = TRUE) :
  no non-missing arguments to max; returning -Inf
3: In max(fitness) : no non-missing arguments to max; returning -Inf
4: In max(x, na.rm = TRUE) :
  no non-missing arguments to max; returning -Inf

Is the above error because I have not made "distance matrix" (i.e. "D") properly? Is there a different way to name the columns and rows of a matrix in R?

Thanks!

Note : If anyone knows another way to solve this constraint Travelling Salesman Problem with custom cities using the Genetic Algorithm in R (e.g. different objective function, different way to specify constraints, etc.), please let me know. I am open to different ways to solving this problem!

user_1855677 · Answer

That’s not the problem. The error says the it encountered code:

if (object@run >= run) break

… and either object@run or run had length 0 which the if function cannot handle gracefully. It may be an error in the ga function itself or in the arguments to it.

To address the direct question about how to make the distance matrix look like the example in eurodist: There is a dimnames attribute for matrices. You need to assign a list with a rownames and a colnames value in it and assign that list to the dimnames attribute.

dimnames(D) <- list(rownames=final_data$names, 
                    colnames=final_data$names)

Then when you run your code you get an error from the ga(...) call:

Error in gaperm_pmxCrossover_Rcpp(object, parents) : index error

Looking at the problem setup, your population size appears much larger than needed. If you drop it down a bit to say 100 or 200, then the results begin to be computed.

popSize=200;
# now calculate a res
colnames(D_perm)[res@solution[1,]]
#[1] "city_4" "city_6" "city_5" "city_1" "city_3" "city_2"

 popSize=100
 colnames(D_perm)[res@solution[1,]]
 #[1] "city_4" "city_6" "city_5" "city_1" "city_3" "city_2"

 popSiz=20
colnames(D_perm)[res@solution[1,]]
#[1] "city_4" "city_6" "city_5" "city_1" "city_3" "city_2"

It doesn't seem "proper" that a population size larger than needed should cause an obscure error, so you might contact the package maintainer with your example (now that it has been "dressed up" properly.)

R: Different Ways to Name Matrices

1 Answers