R：命名矩阵的不同方法

发布于 2025-01-17 08:24:15 字数 8943 浏览 0 评论 0原文

我正在使用 R 编程语言。

在R的“数据集”库中，有一个名为“eurodist”的数据集，其中包含每个城市组合之间的距离：

library(datasets)

然后可以将该数据集转换为“矩阵”：

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

我的问题： 假设我有 6 个城市以及每个城市的经度/纬度：

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

我还可以为这些城市制作一个类似的矩阵，其中包含每对城市之间的距离：

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

如何使我的矩阵看起来相同作为“欧洲主义者”矩阵？

我想到了以下方法来做到这一点：

 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

最后，我想使用上面的矩阵作为自定义旅行商问题的输入（R：自定义旅行商问题） - 例如，当您被迫从“城市 4”开始时，尝试找到最佳路径，并且第三城市应该是“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,]]

这会导致以下错误：

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

上述错误是因为我没有正确制作“距离矩阵”（即“D”）吗？在 R 中是否有不同的方法来命名矩阵的列和行？

谢谢！

注意：如果有人知道使用 R 中的遗传算法解决自定义城市的约束旅行商问题的另一种方法（例如不同的目标函数、指定约束的不同方式等），请告诉我。我愿意采用不同的方法来解决这个问题！

原文

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!

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

溺深海 2025-01-24 08:24:15

那不是问题。该错误表明它遇到了代码：

if (object@run >= run) break

...并且 object@run 或 run 的长度为 0，if 函数无法正常处理。这可能是 ga 函数本身或其参数中的错误。

为了解决有关如何使距离矩阵看起来像 Eurodist 中的示例的直接问题：矩阵有一个 dimnames 属性。您需要分配一个包含 rownames 和 colnames 值的列表，并将该列表分配给 dimnames 属性。

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

然后，当您运行代码时，您会从 ga(...) 调用中收到错误：

gaperm_pmxCrossover_Rcpp（对象，父母）中的错误：索引错误

查看问题设置，您的人口规模似乎比所需的要大得多。如果您将其降低一点，例如 100 或 200，则会开始计算结果。

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"

大于所需的人口规模会导致一个模糊的错误，这似乎并不“合适”，因此您可以使用您的示例联系包维护者（现在它已经正确“装扮”了。）

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.)

回复收藏 0 原文

~没有更多了~