Ошибка Mapply после обновления R и tidyverse

Я работаю над кодом выборки отказа, используя несколько циклов. После обновления R и tidyverse я обнаружил, что код больше не работает, отображая следующую ошибку:

Error: Assigned data `mapply(...)` must be compatible with existing data.
i Error occurred for column `sampled`.
x Can't convert from <integer> to <logical> due to loss of precision.
* Locations: 1.
Run `rlang::last_error()` to see where the error occurred.
In addition: Warning message:
In seq.default(x, y, na.rm = TRUE) :
 extra argument ‘na.rm’ will be disregarded

Код работал ранее и связан с предыдущим вопросом, ссылка на который [здесь] [1]. Я пытался решить (избежать) проблему, используя более старые версии R (3.6) и tidyverse (1.3.0), но теперь у меня есть несколько дополнительных пакетов, которые мне нужно использовать, которые несовместимы со старыми версиями R. Я Я не собираюсь переделывать весь код и надеюсь, что потребуется всего несколько настроек, чтобы заставить его работать с более новыми версиями R и tidyverse.

Изменить Я допустил ошибку в отношении начального df ответа на этот вопрос. Столбцы ID, After_1 и After_2 должны были содержать комбинацию букв и цифр, а не только цифры. Пример df обновлен.

Вот пример модифицированного кода, который отображает те же ошибки, что и мой реальный код:

df <- dfsource
temp_df<-df #temp_pithouse_join used for dynamically created samples
temp_df$sampled <- NA #blanking out the sample column so I can check against NA for the dynamic detereminatination.
temp_df %>% mutate_if(is.factor, as.character) -> temp_df #change factors to characters

for (i in 1:100){ #determines how many iterations to run

  row_list<-as.list(1:nrow(temp_df))
  q<-0

  while(length(row_list)!=0 & q<10){
    q<-q+1 #to make sure that we don't spinning off in an infinite loop
    for(j in row_list){ #this loop replaces the check values
      skip_flag<-FALSE #initialize skip flag used to check the replacement sampling
      for(k in 4:5){ #checking the topoafter columns
        if(is.na(temp_df[j,k])){ 
          # print("NA break")
          # print(i)
          break
        } else if(is.na(as.integer(temp_df[j,k]))==FALSE) { #if it's already an integer, well, a character vector containing an integer, we already did this, next
          # print("integer next")
          next
          # print("integer next")
        } else if(temp_df[j,k]==""){ #check for blank values
          # print("empty string next")
          temp_df[j,k]<-NA #if blank value found, replace with NA
          # print("fixed blank to NA")
          next 
        }
        else if(is.na(filter(temp_df,ID==as.character(temp_df[j,k]))["sampled"])) { #if the replacement has not yet been generated, move on, but set flag to jump this to the end
          skip_flag<-TRUE
          # print("skip flag set")
        } else {
          temp_df[j,k]<-as.integer(filter(temp_df,ID==temp_df[j,k])[6]) #replacing IDs with the sampled dates of those IDs
          # print("successful check value grab")
        } #if-else
      } #k for loop
      if(skip_flag==FALSE){
        row_list<-row_list[row_list!=j]
      } else {
        next 
      }

      #sampling section
      if(skip_flag==FALSE){
        temp_df[j,6]<-mapply(function(x, y) if(any(is.na(x) || is.na(y))) NA else 
          sample(seq(x, y, na.rm = TRUE), 1), temp_df[j,"Start"], temp_df[j,"End"])
        temp_df[j,7]<-i #identifying the run number

        if(any(as.numeric(temp_df[j,4:5])>as.numeric(temp_df[j,6]),na.rm=TRUE)){
          # print(j)
          while(any(as.numeric(temp_df[j,4:5])>as.numeric(temp_df[j,6]),na.rm=TRUE)){
            temp_df[j,6]<-mapply(function(x, y) if(any(is.na(x) || is.na(y))) NA else 
              sample(seq(x, y, na.rm = TRUE), 1), temp_df[j,"Start"], temp_df[j,"End"])
          } #while 
          temp_df[j,7]=i 
        }#if
      }
    } #j for loop
  } #while loop wrapper around j loop
  if(i==1){
    df2<-temp_df
  }else{
    df2<-rbind(df2,temp_df)
  }#else

  #blank out temp_df to prepare for another run
  temp_df<-df
  temp_df$sampled <- NA 
  temp_df %>% mutate_if(is.factor, as.character) -> temp_df 

}#i for loop

А вот пример данных для использования, который я бы прочитал как dfsource:

structure(list(ID = c("A1", "A2", "A3", "A4", "A5", "A6", "A7", 
"A8", "A9", "A10", "A11", "A12", "A13", "A14", "A15", "A16", 
"A17", "A18", "A19", "A20", "A21", "A22", "A23", "A24", "A25", 
"A26", "A27", "A28", "A29", "A30"), Start = c(1, 1, 1, 1, 1, 
50, 50, 50, 50, 50, 100, 100, 100, 100, 100, 200, 200, 300, 250, 
350, 300, 300, 400, 500, 400, 400, 450, 500, 550, 500), End = c(1000, 
1000, 1000, 1000, 1000, 950, 950, 950, 950, 950, 1000, 1000, 
1000, 1000, 900, 800, 900, 750, 650, 650, 600, 850, 700, 600, 
600, 700, 550, 550, 600, 550), After_1 = c("A3", "", "", "", 
"A3", "", "", "", "", "", "", "A11", "", "A11", "", "", "", "", 
"", "", "", "A21", "", "", "", "", "", "", "", "A28"), After_2 = c("", 
"", "", "", "A2", "", "", "", "", "", "", "", "", "A12", "", 
"", "", "", "", "", "", "", "", "", "", "", "", "", "", ""), 
    sampled = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
    NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
    NA, NA, NA)), class = c("spec_tbl_df", "tbl_df", "tbl", "data.frame"
), row.names = c(NA, -30L), spec = structure(list(cols = list(
    ID = structure(list(), class = c("collector_character", "collector"
    )), Start = structure(list(), class = c("collector_double", 
    "collector")), End = structure(list(), class = c("collector_double", 
    "collector")), After_1 = structure(list(), class = c("collector_character", 
    "collector")), After_2 = structure(list(), class = c("collector_character", 
    "collector")), sampled = structure(list(), class = c("collector_logical", 
    "collector"))), default = structure(list(), class = c("collector_guess", 
"collector")), skip = 1), class = "col_spec"))```





  [1]: https://stackoverflow.com/questions/58653809/sample-using-start-and-end-values-within-a-loop-in-r

person Corey    schedule 02.06.2020    source источник
comment
Р 3.6. еще не следует считать старше. R 4.0 еще не выпустила первый патч. Мы должны дождаться хотя бы 4.0.1, прежде чем называть R 3.6 старше.   -  person jangorecki    schedule 02.06.2020
comment
Для последующего анализа я изучаю корреляции, используя ро Спирмена, и хочу включить доверительные интервалы. У RVAideMemoire есть эта функция, но, к сожалению, для нее требуется R 4.0.   -  person Corey    schedule 02.06.2020


Ответы (2)


РЕДАКТИРОВАТЬ: Инициализировать sampled как NA_integer_:

temp_df<-df #temp_pithouse_join used for dynamically created samples
temp_df$sampled <- NA_integer_ #blanking out the sample column so I can check against NA for the dynamic detereminatination.
temp_df %>% mutate_if(is.factor, as.character) -> temp_df #change factors to characters

for (i in 1:100){ #determines how many iterations to run

    row_list<-as.list(1:nrow(temp_df))
    q<-0

    while(length(row_list)!=0 & q<10){
        q<-q+1 #to make sure that we don't spinning off in an infinite loop
        for(j in row_list){ #this loop replaces the check values
            skip_flag<-FALSE #initialize skip flag used to check the replacement sampling
            for(k in 4:5){ #checking the topoafter columns
                if(is.na(temp_df[j,k])){ 
                    break
                } else if(is.na(as.integer(temp_df[j,k]))==FALSE) { #if it's already an integer, well, a character vector containing an integer, we already did this, next
                    # print("integer next")
                    next
                    # print("integer next")
                } else if(temp_df[j,k]==""){ #check for blank values
                    # print("empty string next")
                    temp_df[j,k]<-NA #if blank value found, replace with NA
                    # print("fixed blank to NA")
                    next 
                }
                else if(is.na(filter(temp_df,ID==as.character(temp_df[j,k]))["sampled"])) { #if the replacement has not yet been generated, move on, but set flag to jump this to the end
                    skip_flag<-TRUE
                    # print("skip flag set")
                } else {
                    temp_df[j,k]<-as.integer(filter(temp_df,ID==temp_df[j,k])[6]) #replacing IDs with the sampled dates of those IDs
                    # print("successful check value grab")
                } #if-else
            } #k for loop
            if(skip_flag==FALSE){
                row_list<-row_list[row_list!=j]
            } else {
                next 
            }
            #sampling section
            if(skip_flag==FALSE){
                temp_df[j,6]<-sample(temp_df$Start[j]:temp_df$End[j],1)
                temp_df[j,7]<-i #identifying the run number

                if(any(as.numeric(temp_df[j,4:5])>as.numeric(temp_df[j,6]),na.rm=TRUE)){
                    # print(j)
                    while(any(as.numeric(temp_df[j,4:5])>as.numeric(temp_df[j,6]),na.rm=TRUE)){
                        temp_df[j,6]<-sample(temp_df$Start[j]:temp_df$End[j],1)
                    } #while 
                    temp_df[j,7]=i 
                }#if
            }
        } #j for loop
    } #while loop wrapper around j loop
    if(i==1){
        df2<-temp_df
    }else{
        df2<-rbind(df2,temp_df)
    }#else

    #blank out temp_df to prepare for another run
    temp_df<-df
    temp_df$sampled <- NA_integer_
    temp_df %>% mutate_if(is.factor, as.character) -> temp_df 

}#i for loop

Глядя на первый вопрос, который у вас был (Пример с использованием начальное и конечное значения в цикле в R), я не совсем понимаю, зачем вам нужен mapply, если вы уже выполняете цикл построчно. Почему бы не сделать что-то вроде этого примера:

set.seed(1)
df <- structure(list(ID = structure(1:14, .Label = c("a", "b", "c", 
                                                                                                         "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n"), class = "factor"), 
                                         start = c(25L, 36L, 23L, 15L, 21L, 43L, 39L, 27L, 11L, 21L, 
                                                            28L, 44L, 16L, 25L), end = c(67L, 97L, 85L, 67L, 52L, 72L, 
                                                                                                                     55L, 62L, 99L, 89L, 65L, 58L, 77L, 88L)), class = "data.frame", row.names = c(NA, -14L))

df$sample <- NA

for (row in 1:nrow(df)) {
    df$sample[row] <- sample(df$start[row]:df$end[row], 1)
}

df
#>    ID start end sample
#> 1   a    25  67     28
#> 2   b    36  97     74
#> 3   c    23  85     23
#> 4   d    15  67     48
#> 5   e    21  52     49
#> 6   f    43  72     65
#> 7   g    39  55     49
#> 8   h    27  62     40
#> 9   i    11  99     92
#> 10  j    21  89     79
#> 11  k    28  65     60
#> 12  l    44  58     48
#> 13  m    16  77     36
#> 14  n    25  88     66

Создано 2020-06-02 пакетом reprex (v0.3.0)

Если это сработает, то, надеюсь, у вас больше не будет ошибки, связанной с mapply.

person Valeri Voev    schedule 02.06.2020
comment
Я попытался интегрировать ваше решение, заменив раздел выборки следующим: ,7]‹-i #определение номера запуска if(any(as.numeric(temp_df[j,4:5])›as.numeric(temp_df[j,6]),na.rm=TRUE)){ # print(j) while(any(as.numeric(temp_df[j,4:5])›as.numeric(temp_df[j,6]),na.rm=TRUE)){ temp_df[j,6]‹- sample(temp_df$Start[j]:temp_df$End[j],1) } #while temp_df[j,7]=i Но я получаю аналогичную ‹целочисленную› ‹логическую› ошибку - person Corey; 02.06.2020
comment
См. редактирование. Проблемы с инициализацией столбца sampled как NA_integer_, потому что NA по умолчанию относится к классу logical, поэтому, когда вы выбираете значение и пытаетесь присвоить целое число столбцу класса logical, возникают проблемы. Также обратите внимание, что вам также нужно использовать NA_integer_ в конце кода после комментария #blank out temp_df to prepare for another run. - person Valeri Voev; 02.06.2020
comment
Я взволнованно ввел ваше исправление, а затем понял, что в моем воспроизводимом примере была одна вопиющая ошибка. Столбцы ID, After_1 и After_2 содержат комбинацию букв и цифр, а не только цифры. Я ужасно сожалею об этой ошибке и сейчас обновляю пример df. Ваше решение отлично работает с df, который я изначально предоставил, но я испортил пример. Мои извинения. - person Corey; 02.06.2020
comment
Привет, @Corey, повлияет ли это на проблемы с sampled? - person Valeri Voev; 02.06.2020
comment
Я очень ценю вашу помощь здесь, и я сожалею о путанице. При работе с новыми данными я получаю следующую ошибку: Ошибка: Назначенные данные as.integer(filter(temp_df, ID == temp_df[j, k])[6]) должны быть совместимы с существующими данными. i Произошла ошибка для столбца After_1. x Невозможно преобразовать ‹целое› в ‹символьное›. Запустите rlang::last_error(), чтобы увидеть, где произошла ошибка. Кроме того: Предупреждающие сообщения: 1: In as.integer(temp_df[j, k]): NA введены принудительно - person Corey; 02.06.2020
comment
Поскольку столбец After_1 имеет класс символов (в R вы не можете смешивать типы данных в одном и том же столбце фрейма данных, поэтому, если у вас есть целые числа и символы, целые числа будут преобразованы в символы — попробуйте x <- c(2, "a", 3, "b") и посмотрите на x), вам нужно temp_df[j,k]<-as.character(filter(temp_df,ID==temp_df[j,k])[6]) вместо as.integer(filter(temp_df, ID == temp_df[j, k])[6]). Это создаст эти странные строки символов integer(0), поэтому вам, возможно, придется переосмыслить то, что вы назначаете temp_df[j,k], если это не то, что вы хотели бы иметь. - person Valeri Voev; 02.06.2020

Я хочу поблагодарить тех из вас, кто предложил альтернативные методы решения этой проблемы. Проблема, похоже, была вызвана более старой версией dplyr. Я использовал dplyr 0.8.3, когда у меня возникла ошибка, но теперь код работает с dplyr 1.0.0.

person Corey    schedule 03.06.2020