Рандомизировать данные между двумя столбцами в R

Question

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

Я хочу рандомизировать данные между двумя столбцами. Это должно имитировать ошибочную идентификацию видов в данных полей растительности, поэтому я хочу назначить некоторую вероятность ошибочной идентификации между этими двумя столбцами. Я бы предположил, что есть способ сделать это, используя sample или пакет «переместить».

Я приведу некоторые доступные данные для примера.

library (vegan) 
data (dune) 

Если вы наберете head (dune), то вы можете увидеть, что это кадр данных с сайтами в качестве строк и видов как колонны. Для удобства мы можем предположить, что некоторые полевые технологии могут ошибочно идентифицировать Poa pratensis и Poa trivialis.

poa = data.frame(Poaprat=dune$Poaprat,Poatriv=dune$Poatriv) 
head(poa) 
      Poaprat  Poatriv 
1    4   2 
2    4   7 
3    5   6 
4    4   5 
5    2   6 
6    3   4 

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

  Poaprat  Poatriv 
1    6   0 
2    4   7 
3    5   6 
4    5   4 
5    0   7 
6    4   3 

P.S.

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

*** Редактирование: для большей ясности тип данных, которые будут рандомизированы, будет составлять проценты оценки покрытия (поэтому значения между 0% и 100%). Данные в этом кратком примере являются относительными оценками покрытия, а не считаются.

Answer 1

Вам все равно нужно заменить фактические столбцы новыми, и может быть более элегантный способ сделать это (уже поздно в земле EDT) и вам придется решить, что еще помимо нормального Дистрибутив, который вы хотите использовать (то есть, как вы замените sample()) но вы получите ваши свопы и добавляет с:

library(vegan) 
library(purrr) 

data(dune) 

poa <- data.frame(
    Poaprat=dune$Poaprat, 
    Poatriv=dune$Poatriv 
) 

map2_df(poa$Poaprat, poa$Poatriv, function(x, y) { 
    for (i in 1:length(x)) { 
    what <- sample(c("left", "right", "swap"), 1) 
    switch(
     what, 
     left={ 
     x[i] <- x[i] + y[i] 
     y[i] <- 0 
     }, 
     right={ 
     y[i] <- x[i] + y[i] 
     x[i] <- 0 
     }, 
     swap={ 
     tmp <- y[i] 
     y[i] <- x[i] 
     x[i] <- tmp 
     } 
    ) 
    } 
    data.frame(Poaprat=x, Poatriv=y) 
}) 

Answer 2

Вот мой подход:

Давайте определим функцию, которая будет принимать ряд образцов (n) и вероятность (p), что она может быть помечена неправильно. Эта функция будет пробовать 1 с вероятностью p и 0 с 1-p. Сумма этой случайной выборки даст количество образцов n.

mislabel = function(x, p){ 
    N_mis = sample(c(1,0), x, replace = T, prob = c(p, 1-p)) 
    sum(N_mis) 
} 

После определения функции, применить его к каждому колонку и хранить ее в двух новых колонки

p_miss = 0.3 

poa$Poaprat_mislabeled = sapply(poa$Poaprat, mislabel, p_miss) 
poa$Poatriv_mislabeled = sapply(poa$Poatriv, mislabel, p_miss) 

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

poa$Poaprat_final = poa$Poaprat - poa$Poaprat_mislabeled + poa$Poatriv_mislabeled 
poa$Poatriv_final = poa$Poatriv - poa$Poatriv_mislabeled + poa$Poaprat_mislabeled 

Результат:

> head(poa) 
    Poaprat Poatriv Poaprat_mislabeled Poatriv_mislabeled Poaprat_final Poatriv_final 
1  4  2     0     0    4    2 
2  4  7     1     2    5    6 
3  5  6     0     3    8    3 
4  4  5     1     2    5    4 
5  2  6     0     3    5    3 
6  3  4     1     2    4    3 

Полная процедура:

mislabel = function(x, p){ 
    N_mis = sample(c(1,0), x, replace = T, prob = c(p, 1-p)) 
    sum(N_mis) 
} 


p_miss = 0.3 

poa$Poaprat_mislabeled = sapply(poa$Poaprat, mislabel, p_miss) 
poa$Poatriv_mislabeled = sapply(poa$Poatriv, mislabel, p_miss) 

poa$Poaprat_final = poa$Poaprat - poa$Poaprat_mislabeled + poa$Poatriv_mislabeled 
poa$Poatriv_final = poa$Poatriv - poa$Poatriv_mislabeled + poa$Poaprat_mislabeled 

Переменная p_miss вероятность маркировки неправильно оба вида. Вы также можете использовать другое значение для каждого, чтобы имитировать несимметричную вероятность того, что может быть проще помечать один из них по сравнению с другим.

Answer 3

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

misID = function(X, species,probs = c(0.1,0.1,0,0.8)){ 
library(purrr) 

X2 = X 

if (!is.matrix(species) == T){ 
as.matrix(species) 
} 


if (!is.matrix(probs) == T){ 
probs=matrix(probs,ncol=4,byrow=T) 
} 

if (nrow(probs) == 1){ 
probs = matrix(rep(probs[1,],nrow(species)),ncol=4,byrow=T) 
} 

for (i in 1:nrow(species)){ 

Spp = data.frame(X[species[i,1]],X[species[i,2]]) 


mis = map2_df(Spp[1],Spp[2],function(x,y) { 
    for(n in 1:length(x)) { 
    what = sample(c('left', 'right', 'swap','same'), size=1,prob=probs[i,]) 
    switch(
     what, 
     left = { 
     x[n] = x[n] + y[n] 
     y[n] = 0 
     }, 
     right = { 
     y[n] = x[n] + y[n] 
     x[n] = 0 
     }, 
     swap = { 
     tmp = y[n] 
     y[n] = x[n] 
     x[n] = tmp 
     }, 
     same = { 
     x[n] = x[n] 
     y[n] = y[n] 
     } 
    ) 
} 
misSpp = data.frame(x,y) 
colnames(misSpp) =c(names(Spp[1]),names(Spp[2])) 
return(misSpp) 

}) 
X2[names(mis[1])] = mis[1] 
X2[names(mis[2])] = mis[2] 
} 
return(X2) 
} 

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

Спасибо за указание на пакет «purrr» для меня, а также функцию switch.

Пример:

library(vegan) 
library(labdsv) 
data(dune) 

#First convert relative abundances to my best guess at the % values in Van der Maarel (1979) 
code = c(1,2,3,4,5,6,7,8,9) 
value = c(0.1,1,2.5,4.25,5.5,20,40,60.5,90) 
veg = vegtrans(dune,code,value) 

specpairs = matrix(c("Poaprat","Poatriv","Trifprat","Trifrepe"),ncol=2,byrow=T) #create matrix of species pairs 
probmat = matrix(c(0.3,0,0,0.7,0,0.5,0,0.5),ncol=4,byrow=T)      #create matrix of misclassification probabilities 

veg2 = misID(veg,specpairs,probs = probmat) 

print(veg2)