Эффективная функция для возврата вектора переменной длины из таблицы поиска

У меня есть три источника данных:

types<-c(1,3,3)
places<-list(c(1,2,3),1,c(2,3))
lookup.counts<-as.data.frame(matrix(runif(9,min=0,max=10),nrow=3,ncol=3))
assigned.places<-rep.int(0,length(types))

числа в векторе «типы» говорят мне, к какому «типу» относится данное наблюдение. Векторы в списке мест говорят мне, в каких местах можно найти наблюдение (некоторые наблюдения находятся только в одном месте, другие во всех местах). По определению для каждого наблюдения существует одна запись в типах и один список мест. Lookup.counts сообщает мне, сколько наблюдений каждого типа находится в каждом месте (генерируется из другого источника данных).

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

for (i in 1:length(types)){
  row<-types[i]
  columns<-places[[i]]
  this.obs<-lookup.counts[row,columns] #the counts of this type in each place
  total<-sum(this.obs)
  this.obs<-this.obs/total #the share of observations of this type in these places
  pick<-runif(1,min=0,max=1)

  #the following should really be a 'while' loop, but regardless it needs help
  for(j in 1:length(this.obs[])){
    if(this.obs[j] > pick){
      #pick is less than this county so assign
      pick<- 100 #just a way of making sure an observation doesn't get assigned twice
      assigned.places[i]<-colnames(lookup.counts)[j]
    }else{
      #pick is greater, move to the next category
      pick<- pick-this.obs[j]
    }
  }
}

Я пытался как-то векторизовать это, но зацикливаюсь на переменной длине «мест» и «этого.об».

На практике, конечно, таблица lookup.counts немного больше (500 x 40), и у меня есть около 900 тысяч наблюдений со списками мест длиной от 1 до 39.


r vectorization lookup-tables
person csfowler    schedule 22.10.2012    source источник
comment
хорошим первым шагом было бы поместить все эти данные в один объект. Я думаю, вы можете использовать data.frame с записью для каждого наблюдения. Но по вашему описанию сложно сказать. Вы также можете использовать вложенный именованный список, но тогда вы перейдете к lapply, и это не будет векторизовано.   -  person Justin    schedule 22.10.2012
comment
@Justin, data.frame не будет принимать ни столбцы типа списка, ни строки с разным количеством столбцов.   -  person MvG    schedule 22.10.2012
comment
@MvG да, но я бы предложил сделать несколько строк для списков (например, длинные и широкие данные)   -  person Justin    schedule 22.10.2012
comment
@Justin, несколько входных строк для желаемого результата вывода будут означать tapply или подобное, что не намного лучше, чем lapply.   -  person MvG    schedule 22.10.2012
comment
введите data.table. но я не думал об этом очень далеко, поэтому у меня нет ответа :)   -  person Justin    schedule 22.10.2012

Ответы (2)


arrow_upward
1
arrow_downward

Похоже, это тоже работает:

# More convenient if lookup.counts is a matrix.
lookup.counts<-matrix(runif(9,min=0,max=10),nrow=3,ncol=3)
colnames(lookup.counts)<-paste0('V',1:ncol(lookup.counts))

# A function that does what the for loop does for each i
test<-function(i) {
  this.places<-colnames(lookup.counts)[places[[i]]]
  this.obs<-lookup.counts[types[i],this.places]
  sample(this.places,size=1,prob=this.obs)
}

# Applies the function for all i
sapply(1:length(types),test)
person nograpes    schedule 22.10.2012
comment
Переводит мою функцию с часов на секунды. Я знал, что есть способ. Я бы не добрался сюда сам, и не уверен, почему это намного быстрее, чем MvG, но это так. Спасибо. - person csfowler; 23.10.2012
comment
Если вам интересно узнать, как сделать это самостоятельно, я рекомендую сначала попытаться превратить цикл for в функцию. Попробуйте работать с исходной функцией и просто удалите строку for и замените ее на test<-function(i). Начните оттуда и посмотрите, сможете ли вы sapply выполнить свою функцию. Затем работайте над улучшением функции. - person nograpes; 24.10.2012

arrow_upward
2
arrow_downward

Чтобы векторизовать внутренний цикл, вы можете использовать sample или sample.int для выбора из нескольких альтернатив с заданными вероятностями. Если я неправильно прочитал ваш код, вам нужно что-то вроде этого:

assigned.places[i] <- sample(colnames(this.obs), 1, prob = this.obs)

Я немного удивлен, что вместо этого вы используете colnames(lookup.counts). Разве это не должно быть подмножеством columns? Похоже, либо я что-то упустил, либо в вашем коде есть ошибка.

разная длина ваших списков является серьезным препятствием для векторизации ваших внешних циклов. Возможно, вы могли бы использовать пакет Matrix для хранения этой информации в виде разреженных матриц. Затем вы можете просто умножить вероятности на этот вектор, чтобы исключить те столбцы, которых нет в списке мест данного наблюдения. Но поскольку вы, вероятно, по-прежнему использовали бы apply для приведенного выше кода выборки, вы могли бы также сохранить список и использовать некоторую форму apply для его повторения.

Общий результат может выглядеть примерно так:

assigned.places <- colnames(lookup.counts)[
  apply(cbind(types, places), 1, function(x) {
    sample(x[[2]], 1, prob=lookup.counts[x[[1]],x[[2]]])
  })
]

Использование cbind и apply не особенно красиво, но, кажется, работает. Каждый x представляет собой список из двух элементов, x[[1]] — тип, а x[[2]] — соответствующие места. Мы используем их для индексации lookup.counts так же, как и вы. Затем мы используем найденные счетчики как относительные вероятности при выборе индекса одного из столбцов, которые мы использовали в индексе. Только после того, как все эти числа будут собраны в единый вектор к apply, индексы будут преобразованы в имена на основе colnames.

Вы можете проверить, работают ли вещи быстрее, если вы не cbindstuff вместе, а вместо этого выполняете итерацию только по индексам:

assigned.places <- colnames(lookup.counts)[
  sapply(1:length(types), function(i) {
    sample(places[[i]], 1, prob=lookup.counts[types[i],places[[i]]])
  })
]
person MvG    schedule 22.10.2012
comment
Оба работают. Спасибо, и спасибо за описание того, почему они работают. Очень полезно. ответ nograpes намного быстрее, поэтому я согласен с этим, но ваши усилия оценены. - person csfowler; 23.10.2012
comment
@csfowler, вы можете выразить свою признательность, нажав на красивую стрелку вверх рядом с моим вопросом. :-) Хотя вы можете принять только один ответ, вы вполне можете проголосовать за несколько правильных и/или полезных ответов. - person MvG; 23.10.2012