Произошел неправильный продукт в оценке попарной ошибки в R - PullRequest
Новая
       7

Произошел неправильный продукт в оценке попарной ошибки в R

0 голосов
/ 30 октября 2018

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

pw.data = data.frame(true_tree = rep(c("maple","oak","pine"),3), 
                 guess_tree = c(rep("maple",3),rep("oak",3),rep("pine",3)),
                 value = c(12,0,1,1,15,0,2,1,14))


true_tree guess_tree value
  maple      maple    12
    oak      maple     0
   pine      maple     1
  maple        oak     1
    oak        oak    15
   pine        oak     0
  maple       pine     2
    oak       pine     1
   pine       pine    14

Итак, я хочу оценить попарную ошибку между истинными видами деревьев и угаданными. Для этой оценки формула должна быть «попарно неправильные присвоения / все количество оценок для выбранных двух видов.

Чтобы дать лучшее объяснение: неправильная догадка для клена и дуба (сравнение клен-дуб и дуб-клен) = 1 + 0 / все количество догадок = 12 + 1 + 2 (все считается для true_tree == "клен) + 0 + 15 + 1 (все считается для true_tree == "дуб). Таким образом, оценка продукта составляет 1/31.

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

sum(pw.data[((pw.data[,1] == "maple" & pw.data[,2] == "oak") | 
      (pw.data[,1] == "oak" & pw.data[,2] == "maple")) &
      (pw.data[,1] != pw.data[,2]),3]) / 
 (sum(pw.data[pw.data[,1] == "maple",3]) + sum(pw.data[pw.data[,1] == "oak",3]))

Тем не менее, я хочу сделать эти оценки для больших данных, и поэтому я хочу создать цикл / функцию для выполнения самой оценки и сохранения результатов во фрейме данных, например: 

Pw_tree   value
Maple-oak 0.0123
....

Я пытался использовать эту логику в цикле for, как показано ниже, но он вообще не работает. 

for (i in pw.data[,1]) { 
for (j in pw.data[,2]) {
x = sum( pw.data[((pw.data[,1] == i & pw.data[,2] == j ) | 
                (pw.data[,1] == j & pw.data[,2] == i)) &
               (pw.data[,1] != pw.data[,2]),3])  
y = (sum(pw.data[pw.data[,1] == i,3]) + sum(pw.data[pw.data[,1] == j,3]))
   PWerr_data = data.frame( pw_tree = paste(i,j, sep = "-"), value = x/y)
 }

}

Это было бы здорово, если бы я мог видеть, что я сделал не так. Большое спасибо!

1 Ответ

0 голосов
/ 30 октября 2018

Обычно я решаю проблемы такого типа, создавая функцию, которую я хочу применить (которую вы почти сделали), а затем создавая структуру данных, к которой было бы удобнее ее применять, и затем я могу использовать одну из apply семейство функций для итерации по моей структуре данных для результатов. Это позволяет мне избегать for структур циклов, что хорошо, потому что я из тех программистов, которые неизменно запутывают индекс в двойном цикле for.

В вашем случае мы можем заключить ваше соотношение сумм в функцию, которая принимает data.frame и два имени дерева в качестве аргументов. Тогда нам просто нужно создать набор пар, с которыми мы хотим работать. Удобная функция - combn(), которая позволяет вам брать все комбинации размера m из элементов x: это даст нам желаемый набор не избыточных пар.

Пример кода с комментариями ниже: 

# Load your data
pw.data = data.frame(true_tree = rep(c("maple","oak","pine"),3), 
                     guess_tree = c(rep("maple",3),rep("oak",3),rep("pine",3)),
                     value = c(12,0,1,1,15,0,2,1,14))
pw.data
#>   true_tree guess_tree value
#> 1     maple      maple    12
#> 2       oak      maple     0
#> 3      pine      maple     1
#> 4     maple        oak     1
#> 5       oak        oak    15
#> 6      pine        oak     0
#> 7     maple       pine     2
#> 8       oak       pine     1
#> 9      pine       pine    14

# build the function we will repeatedly apply
getErr <- function(t1, t2, data=pw.data) {
  # compute the rate as you wrote it
  rate <- sum(data[((pw.data[,1] == t1 & data[,2] == t2) | 
               (data[,1] == t2 & data[,2] == t1)) &
              (data[,1] != data[,2]),3]) / 
  (sum(data[data[,1] == t1,3]) + sum(data[data[,1] == t2,3]))

  # output the items involved as a named list (useful for later)
  list(Pw_tree = paste(t1, t2, sep='-'), error_rate = rate)
  }

# test it
getErr("maple", "oak")
#> $Pw_tree
#> [1] "maple-oak"
#> 
#> $error_rate
#> [1] 0.03225806
# Good this matches the output you supplied

# build the data structure we will run the function across
all.trees <- unique(c(as.character(pw.data$true_tree), as.character(pw.data$guess_tree)))
all.name.combos <- combn(all.trees, 2)

# we will use the do.call(rbind, ls) trick, where we generate a list
# with the apply function and coerce it to a matrix
error_rates_df <- do.call(rbind, apply(all.name.combos, 2, function(row){getErr(row[1], row[2])}))
error_rates_df
#>      Pw_tree      error_rate
#> [1,] "maple-oak"  0.03225806
#> [2,] "maple-pine" 0.1       
#> [3,] "oak-pine"   0.03225806

Создан в 2018-10-30 пакетом Представление (v0.2.1)

...