Пользовательская функция, возвращающая неверное значение - пример (конфликтующие имена векторов)

#r #dataframe #lapply #sapply

Вопрос:

По какой-то причине я не могу получить то же значение при применении пользовательской функции с помощью:

 MSD_p<-function(values,letters){
                  a<-abs(apply(combn(values,2), 2, diff))
                  b<-combn(letters,2)
                  c<-data.frame(t(rbind(a,b)))
                  c$a<-as.numeric(c$a)
                  c<-c[order(c$a),]
                  c$unique <- !sapply(gsub(" ", "", paste(c$V2, c$V3)), function(x) any(str_count(x, letters)>1))
                  m_1<-mean(c(min(c[c$unique==TRUE,]$a),max(c[c$unique==FALSE,]$a)))
                  c$unique_lag_3 <- ifelse(lag(c$unique) != c$unique amp; 
                                           lag(lag(c$unique)) != c$unique amp;
                                           lead(c$unique) == c$unique , "New", "Same")
                  rows <- lapply(which(c$unique_lag_3=="New"), function(x) (x-1):(x))
                  m_2<-mean(c[unlist(rows),]$a)
                  m_2<-as.numeric(m_2)
                  return(m_2)
}

MSD_p(dt3$values,dt3$letters)

Это приводит к 8,5.

против

                   a<-abs(apply(combn(dt3$values,2), 2, diff))
                  b<-combn(dt3$letters,2)
                  c<-data.frame(t(rbind(a,b)))
                  c$a<-as.numeric(c$a)
                  c<-c[order(c$a),]
                  c$unique <- !sapply(gsub(" ", "", paste(c$V2, c$V3)), function(x) any(str_count(x, letters)>1))
                  m_1<-mean(c(min(c[c$unique==TRUE,]$a),max(c[c$unique==FALSE,]$a)))
                  c$unique_lag_3 <- ifelse(lag(c$unique) != c$unique amp; 
                                           lag(lag(c$unique)) != c$unique amp;
                                           lead(c$unique) == c$unique , "New", "Same")
                  rows <- lapply(which(c$unique_lag_3=="New"), function(x) (x-1):(x))
                  m_2<-mean(c[unlist(rows),]$a)
                  m_2<-as.numeric(m_2);m_2

Это приводит к 9,75.

Как это возможно? Данные:

 dt3<-data.frame(structure(list(trial_number = c(20L, 20L, 20L, 20L, 20L, 20L, 
20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 
20L), values = c(74.7, 81.1, 80.1, 90.1, 98.9, 96.1, 93.5, 95, 
99.6, 93.3, 96.7, 92.7, 94.7, 92.1, 100.3, 97.4, 94.1, 97.3, 
97.1, 93.1), letters = c("g", "cd", "d", "bc", "ab", "ab", "ab", 
"ab", "ab", "ab", "ab", "ab", "ab", "ab", "a", "ab", "ab", "ab", 
"ab", "ab")), row.names = c(NA, -20L), class = c("tbl_df", "tbl", 
"data.frame")))

Спасибо за помощь.

Ответ №1:

Во внешнем коде функции OP использует letters , который является встроенным вектором, R и он не исходит из столбца «dt3» «буквы»

 c$unique <- !sapply(gsub(" ", "", paste(c$V2, c$V3)), 
       function(x) any(str_count(x, letters)>1))

Это должно быть dt3$letters

Наряду с тем фактом, что создание имен объектов с именами функций ( c ) или letters (встроенные векторы) может привести к ошибочным ситуациям

Поскольку операция называла встроенную структуру в коде, можно использовать dt3$letters вместо letters или просто для воспроизведения вывода, измените строку выше на

 c$unique <- !sapply(gsub(" ", "", paste(c$V2, c$V3)), 
       function(x) any(str_count(x, dt3$letters)>1))

Запуск кода дает

 m_2
[1] 8.5

1. @akrun, спасибо за помощь. Во второй раз ты помог мне сейчас… Я действительно пошел туда и изменил все имена векторов, что могло привести к ошибкам. Однако это должно быть c$unique <- !sapply(gsub(» «, «», вставка(c$V2, c$V3)), функция(x) любая(str_count(x, буквы)>1), потому что она подсчитывает количество уникальных букв в строке. Теперь я решил эту проблему с помощью приведенного выше кода. Конечное значение должно быть 9,75

2. @Garn_R да, в любом случае. letters является вектором по умолчанию. В функции она вызывается извне dt3$letters и является вектором по умолчанию

3. Должен ли я удалить этот пост или оставить его здесь?

Ответ №2:

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

 MSD_p<-function(value,letter){
                  n<-abs(apply(combn(value,2), 2, diff))
                  l<-combn(letter,2)
                  dt<-as.data.frame(t(rbind(n,l)))
                  dt$n<-as.numeric(dt$n)
                  dt<-dt[order(dt$n),]
                  dt$inter <- !sapply(gsub(" ", "", paste(dt$V2, dt$V3)), function(x) any(str_count(x, letters)>1))
                  dt$inter_lag <- ifelse(lag(dt$inter) != dt$inter amp; 
                                           lag(lag(dt$inter)) != dt$inter amp;
                                           lead(dt$inter) == dt$inter , "New", "Same")
                  rows <- lapply(which(dt$inter_lag=="New"), function(x) (x-1):(x))
                  msd<-mean(dt[unlist(rows),]$n)
                  return(msd)
}



dt3 <- dt3 %>% group_by(trial_number) %>%
                  mutate(bb=MSD_p(value,letter))