Извлечь максимальное значение из матрицы на основе случайной выборки по месяцам - PullRequest
Новая
       23

Извлечь максимальное значение из матрицы на основе случайной выборки по месяцам

0 голосов
/ 04 июля 2018

У меня есть матрица расстояний df1, показывающая расстояния между 8 точками a: h 

x <- c("a","b","c","d","e","f","g","h")
df1 <- data.frame(a=c(0,1,2,3,4,5,6,7), b=c(1,0,1,2,3,4,5,6),
                  c=c(2,1,0,1,2,3,4,5), d=c(3,2,1,0,1,2,3,4),
                  e=c(4,3,2,1,0,1,2,3), f=c(5,4,3,2,1,0,1,2),
                  g=c(6,5,4,3,2,1,0,1), h=c(7,6,5,4,3,2,1,0),
                  row.names=x)

> df1
  a b c d e f g h
a 0 1 2 3 4 5 6 7
b 1 0 1 2 3 4 5 6
c 2 1 0 1 2 3 4 5
d 3 2 1 0 1 2 3 4
e 4 3 2 1 0 1 2 3
f 5 4 3 2 1 0 1 2
g 6 5 4 3 2 1 0 1
h 7 6 5 4 3 2 1 0

У меня также есть другой фрейм данных df2, показывающий местоположения, записанные в каждом месяце 

df2 <- data.frame(Month=c(rep(11,3),rep(12,4),rep(1,3)),
                  Location=sample(letters[1:8],10,replace=T))

> df2
   Month Location
1     11        c
2     11        a
3     11        d
4     12        f
5     12        c
6     12        f
7     12        a
8      1        b
9      1        b
10     1        h

Я хочу извлечь максимальное расстояние между записанными местоположениями для каждого месяца. Вывод должен выглядеть примерно так 

  Month Max.Distance
1    11            3
2    12            5
3     1            6

Мне также было бы интересно рассчитать совокупное расстояние между местоположениями для каждого месяца, результат которого будет выглядеть следующим образом: 

  Month Cum.Distance
1    11            5
2    12           11
3     1            6

Надеюсь, это имеет смысл. Я подумал об использовании цикла for, но мои знания о циклах R ограничены, поэтому любая помощь будет принята с благодарностью. Большое спасибо!

Ответы [ 2 ]

0 голосов
/ 04 июля 2018

Сначала я определяю фреймы данных в соответствии с вашим примером. 

x <- c("a","b","c","d","e","f","g","h")
df1 <- data.frame(a=c(0,1,2,3,4,5,6,7), b=c(1,0,1,2,3,4,5,6),
                  c=c(2,1,0,1,2,3,4,5), d=c(3,2,1,0,1,2,3,4),
                  e=c(4,3,2,1,0,1,2,3), f=c(5,4,3,2,1,0,1,2),
                  g=c(6,5,4,3,2,1,0,1), h=c(7,6,5,4,3,2,1,0),
                  row.names=x)

df2 <- data.frame(Month=c(rep(11,3),rep(12,4),rep(1,3)),
                  Location=sample(letters[1:8],10,replace=T))

#    Month Location
# 1     11        d
# 2     11        c
# 3     11        h
# 4     12        e
# 5     12        c
# 6     12        b
# 7     12        h
# 8      1        h
# 9      1        g
# 10     1        b

Далее я определяю функцию, которая находит все возможные комбинации местоположений за месяц m, а затем ищет максимальное расстояние. 

# Find maximum distance
max_dist <- function(m){
  # Check if it's just one location
  if(sum(df2$Month == m) == 1)return(0)

  # Get all combinations of locations for given month
  tmp <- t(combn(match(df2$Location[df2$Month == m], rownames(df1)), 2))

  # Get max value from these location combinations
  max(df1[tmp[, 1], tmp[, 2]])
}

Наконец, я применяю функцию ко всем месяцам в df2 и переупаковываю как фрейм данных. 

# Run function on all months
data.frame(month = unique(df2$Month), max_dist = unlist(lapply(unique(df2$Month), max_dist)))

#   month max_dist
# 1    11        5
# 2    12        6
# 3     1        6

Ниже указано общее расстояние: 

tot_dist <- function(m){
  tmp <- match(df2$Location[df2$Month == m], rownames(df1))  
  sum(df1[cbind(head(tmp, -1), tail(tmp, -1))])
}

В ответ на ваш комментарий, я думаю, что это работает: 

# Find maximum distance
max_dist <- function(m){
  # Check if it's just one location
  if(sum(df2$Month == m) == 1)return(0)

  # Get all locations
  locs <- which(df2$Month == m)
  if(tail(which(df2$Month == m), 1) != nrow(df2))locs <- c(locs, tail(which(df2$Month == m), 1) + 1)

  # Get all combinations of locations for given month
  tmp <- t(combn(match(df2$Location[locs], rownames(df1)), 2))

  # Get max value from these location combinations
  max(df1[tmp[, 1], tmp[, 2]])
}

По сути, он просто получает следующую строку в дополнение к тем за месяц m, если есть еще одна строка. Общий эквивалент расстояния выглядит следующим образом: 

tot_dist <- function(m){
  # Get all locations
  locs <- which(df2$Month == m)
  if(tail(which(df2$Month == m), 1) != nrow(df2))locs <- c(locs, tail(which(df2$Month == m), 1) + 1)

  tmp <- match(df2$Location[locs], rownames(df1))  
  sum(df1[cbind(head(tmp, -1), tail(tmp, -1))])
}
0 голосов
/ 04 июля 2018 
df2 <- read.table(text = "
Month Location
1     11        c
2     11        a
3     11        d
4     12        f
5     12        c
6     12        f
7     12        a
8      1        b
9      1        b
10     1        h", h = T)

aggregate(Location ~ Month, df2, function(j) diff(range(sapply(j, function(i) grep(i, letters)))))

  Month Location
1     1        6
2    11        3
3    12        5

Для вашей второй цели: 

aggregate(Location ~ Month, df2, function(j) sum(abs(diff(sapply(j, function(i) grep(i, letters))))))

  Month Location
1     1        6
2    11        5
3    12       11
...