Найти минимальное отклонение от вектора из матрицы возможных векторов

Question

У меня есть следующий данные

set.seed(11) 
Data<-rbind(c(1:5),c(2:6)) 


Candidates <- matrix(1:25 + rnorm(25), ncol=5, 
dimnames=list(NULL, paste0("x", 1:5))) 
colnames(Data)<-colnames(Candidates) 

Я хочу, чтобы вычесть каждую строку моих данных из каждой строки матрицы Кандидатов И возвращает минимальное абсолютное значение Поэтому для первой строки я хочу узнать наименьшую возможную ошибку.

sum(abs(Data[1,]-Candidates[1,])) 
sum(abs(Data[1,]-Candidates[2,])) 
sum(abs(Data[1,]-Candidates[3,])) 
sum(abs(Data[1,]-Candidates[4,])) 
sum(abs(Data[1,]-Candidates[5,])) 

В данном случае это 38.15826. На данный момент мне не интересно узнать, какая строка кандидата приводит к наименьшему абсолютному отклонению, я просто хочу знать наименьшее абсолютное отклонение для каждой строки данных.

Тогда я хотел бы получить новый набор данных, который имеет мои исходные данные и наименьшее отклонение, например. строка один хотел бы это:

x1 x2 x3 x4 x5 MinDev 
1 2 3 4 5 38.15826 

Мой реальный кандидат Матрица является относительно небольшой, но мой реальный данных довольно велик, поэтому на данный момент я просто строить цикл, который

Err[i,]<- min(rbinds( 
    sum(abs(Data[i,]-Candidates[1,])), 
    sum(abs(Data[i,]-Candidates[2,]))...)) 

но я «Конечно, есть лучший, более автоматический способ сделать это, чтобы он мог вмещать большие матрицы данных и матрицы кандидатов разных размеров.

Любые идеи?

Answer 1

Вы можете использовать sweep, rowSums и apply автоматизировать этот

sum(abs(Data[1,]-Candidates[1,])) ## 38.15826 

Тестирование на первом ряду Data:

min(
    rowSums(abs(
       ## subtract row 1 of Data from each row of Candidates 
       sweep(Candidates,2,Data[1,],"-")))) 
## 38.15826 

Для удобства/читаемости, инкапсулировать это в функции:

getMinDev <- function(x) { 
    min(rowSums(abs(sweep(Candidates,2,x,"-")))) 
} 

Теперь приложение LY к каждой строке Data:

cbind(Data,MinDev=apply(Data,1,getMinDev)) 

Там могут быть методы, которые немного быстрее, чем sweep (например, матричные вычисления, указанные в ответе @ e4e5f4), но это должно быть хорошей базой. Мне нравится sweep, потому что он описательный и не зависит от того, что R использует упорядочивание матриц столбцов.

Answer 2

Вы можете использовать apply с некоторыми матричными операциями:

CalcMinDev <- function(x) 
{ 
    m <- t(matrix(rep(x, nrow(Candidates)), nrow=nrow(Candidates))) 
    min(rowSums(abs(m - Candidates))) 
} 

cbind(Data, MinDev=apply(Data, 1, CalcMinDev)) 

Answer 3

После @ предложения BenBolker, чтобы превратить свой комментарий (используя dist функции с method="manhattan") к ответу:

Идея: Хитрость заключается в том, что если вы поставите матрицу на dist, она вернет расстояние всех комбинаций назад как нижняя треугольная матрица.

dist(rbind(Candidates, Data), method="manhattan") 
#   1   2   3   4   5   6 
# 2 8.786827             
# 3 11.039044 3.718396           
# 4 16.120267 7.333440 6.041076        
# 5 21.465682 12.678855 10.426638 5.345415      
# 6 38.158256 45.763021 48.015238 53.096461 58.441876   
# 7 35.158256 40.763021 44.048344 48.096461 53.441876 5.000000 

Здесь шестая строка и седьмой строка (с индекса 1 до 5) является расстоянием вы заинтересованы в.Итак, в основном, вам просто нужно вычислить индексы, чтобы извлечь интересующие вас элементы.

---

Конечный код будет выглядеть следующим образом:

idx1 <- seq_len(nrow(Data)) + nrow(Candidates) 
idx2 <- seq_len(ncol(Candidates)) 
tt <- dist(rbind(Candidates, Data), method="manhattan") 
transform(Data, minDev = apply(as.matrix(tt)[idx1, idx2], 1, min)) 
# x1 x2 x3 x4 x5 minDev 
# 6 1 2 3 4 5 38.15826 
# 7 2 3 4 5 6 35.15826