Рассчитать расстояние Хаусдорфа между всеми фреймами данных списка - PullRequest
Новая
       10

Рассчитать расстояние Хаусдорфа между всеми фреймами данных списка

0 голосов
/ 10 мая 2019

У меня есть список фреймов данных с 4 столбцами в каждом и разным количеством строк.Я хочу рассчитать расстояние Хаусдорфа для всех фреймов данных в списке и заполнить матрицу результатов.

library(pracma)
Создание списка 
    data_frame1<-data.frame("ID"=1:10, "Sum1"= c(4, -2, 16, 20, 13, 4,2,0, 0, -12),  "Sum2"=c(-3,-6, 0, 10, 6, 2, 4, -8, 0, 0))
    data_frame2<-data.frame("ID"=1:6, "Sum1"= c(13, 4,2,0, 0, -12),  "Sum2"=c(10, 6, 2, 4, -8, 0))
    data_frame3<-data.frame("ID"=1:5, "Sum1"= c(9,3,5,-6,-1),  "Sum2"=c(-2,-4,5, 20,38))
    data_frame4<-data.frame("ID"=1:12, "Sum1"= c(3,4, 9,3,5,-5, -6,-1,0,16,11,9),  "Sum2"=c(-2,8,8,17, 14,-4,5, 21,30, 10, -15,3))


my_list<- list(data_frame1, data_frame2, data_frame3, data_frame4)
Создание матрицы 4x4 для заполнения ее результатами по расстоянию 
hausdist<-matrix(, 4,4)

i<-1:4
Примечание Я хочу рассчитать только расстояние для столбцов 2 и 3 
P<-as.matrix(my_list[[i]][c(2,3)])
Q<-as.matrix(my_list[[i+1]][c(2,3)])
### Loop for calculation of hausdorff distance.
for (i in (i+1):3) { 
  hausdist[[i]]<- print(hausdorff_dist(P,Q))
}
print(hausdist)
 [,1]     [,2] [,3] [,4]
[1,]       NA 13.15295   NA   NA
[2,]       NA       NA   NA   NA
[3,] 13.15295       NA   NA   NA
[4,] 13.15295       NA   NA   NA

#### Correct values:
hausdorff_dist(as.matrix(my_list[[3]][c(2,3)]),as.matrix(my_list[[4]][c(2,3)]))
[1] 13.15295
> hausdorff_dist(as.matrix(my_list[[1]][c(2,3)]),as.matrix(my_list[[2]][c(2,3)]))
[1] 10.44031

При расчете расстояния отдельно результатыправильно, но с циклом у меня одинаковое значение для всех пар фреймов данных.

Ответы [ 2 ]

2 голосов
/ 10 мая 2019

Попробуйте двойную sapply петлю. 

hd <- function(X, Y){
  P <- as.matrix(X[2:3])
  Q <- as.matrix(Y[2:3])
  hausdorff_dist(P, Q)
}

sapply(my_list, function(X){
  sapply(my_list, function(Y) hd(X, Y))
})
#         [,1]     [,2]     [,3]     [,4]
#[1,]  0.00000 10.44031 34.13210 26.07681
#[2,] 10.44031  0.00000 31.30495 23.85372
#[3,] 34.13210 31.30495  0.00000 13.15295
#[4,] 26.07681 23.85372 13.15295  0.00000

Хотя предыдущее решение кажется мне более интуитивно понятным, здесь приведен однострочный текст, использующий outer и Map. 

outer(my_list, my_list, FUN = function(x, y) Map(hd, x, y))
#     [,1]     [,2]     [,3]     [,4]    
#[1,] 0        10.44031 34.1321  26.07681
#[2,] 10.44031 0        31.30495 23.85372
#[3,] 34.1321  31.30495 0        13.15295
#[4,] 26.07681 23.85372 13.15295 0
0 голосов
/ 10 мая 2019

Вы можете использовать apply для всех перестановок фреймов данных 

# extract only the relevant columns
l1 <- lapply(my_list, function(x) as.matrix(x)[,2:3])
# create all permutations of the data sets
combs <- t(expand.grid(l1,l1))
# calculate distances for each combination and rearrange
d <- apply(combs, 2, function(x) hausdorff_dist(x[1][[1]], x[2][[1]]))
matrix(d, nrow = length(my_list), ncol = length(my_list))

#      [,1]     [,2]     [,3]     [,4]
#[1,]  0.00000 10.44031 34.13210 26.07681
#[2,] 10.44031  0.00000 31.30495 23.85372
#[3,] 34.13210 31.30495  0.00000 13.15295
#[4,] 26.07681 23.85372 13.15295  0.00000
...