Ну, похоже, вам сначала нужно сгенерировать n-кортежей из вашего вектора. Следующая функция должна выполнить это:
makeTuples <- function( x, n ){
# Very inefficient way to loop... but what the heck
tuples <- list()
for( i in 1:n ){
tuples[[i]] <- x[i:(length(x)-n+i)]
}
return(tuples)
}
Тогда вы можете передать результаты makeTuples()
в table()
, используя do.call()
:
do.call( table, makeTuples(s,3) )
, , = 0
0 1
0 4 1
1 3 1
, , = 1
0 1
0 2 1
1 0 1
Это работает, потому что функция makeTuples()
возвращает кортежи в виде списка списков. Вывод не так хорош, как вы хотели, но вы могли бы написать функцию для переформатирования, скажем:
, , = 0
0 1
0 4 1
1 3 1
Кому:
0 1
00 4 1
01 3 1
Это потребует циклического перебора внешних n-2 измерений n-мерного массива, возвращаемого table
, создания имен строк и объединения элементов вместе.
Обновление
Итак, я просто сидел в классе процессов Stochastic, когда нашел более или менее прямой способ получения нужного результата, не пытаясь развернуть вывод table()
. Сначала вам понадобится функция, которая генерирует все возможные перестановки из n выборок из вашего населения. Генерация перестановок может быть сделана с помощью expand.grid()
, но для этого требуется небольшое сахарное покрытие:
permute <- function( population, n ){
permutations <- do.call( expand.grid, rep( list(population), n ) )
permutations <- apply( permutations, 1, paste, collapse = '' )
return( permutations )
}
Основная идея состоит в том, чтобы перебрать список перестановок и посчитать количество кортежей, которые соответствуют данной перестановке. Поскольку вы хотите, чтобы результаты были разбиты на таблицы, мы должны выбрать перестановку из n-1 элементов из совокупности и позволить последней позиции сформировать столбцы таблицы. Вот функция, которая принимает перестановку размера n-1, список кортежей и совокупность, из которой были взяты кортежи, и создает именованный вектор количества совпадений:
countFrequency <- function(permutation,tuples,population){
permutations <- paste( permutation, population, sep = '' )
# Inner lapply applies the equality operator `==` to each
# permutation and returns a list of TRUE/FALSE vectors.
# Outer lapply sums the number of TRUE values in each vector.
frequencies <- lapply(lapply(permutations,`==`,tuples),sum)
names( frequencies ) <- as.character( population )
return( unlist(frequencies) )
}
Наконец, все три функции могут быть объединены в большую функцию, которая принимает вектор, разбивает его на n-кортежи и возвращает таблицу частот. Последняя операция агрегации выполняется с использованием ldply()
из пакета plyr
Хэдли Уикхэма, поскольку она отлично справляется с задачей сохранения информации, например, какая перестановка соответствует какой строке выходных данных соответствует:
permutationFrequency <- function( vector, n, population = unique( vector ) ){
# Split the vector into tuples.
tuples <- makeTuples( vector, n )
# Coerce and compact the tuples to a vector of strings.
tuples <- do.call(cbind,tuples)
tuples <- apply( tuples, 1, paste, collapse = '' )
# Generate permutations of n-1 elements from the population.
# Turn into a named list for ldply() to work it's magic.
permutations <- permute( population, n-1 )
names( permutations ) <- permutations
frequencies <- ldply( permutations, countFrequency,
tuples = tuples, population = population )
return( frequencies )
}
И вот, пожалуйста:
require( plyr )
permutationFrequency( s, 2 )
.id 1 0
1 1 2 3
2 0 2 7
permutationFrequency( s, 3 )
.id 1 0
1 11 1 1
2 01 1 1
3 10 0 3
4 00 2 4
permutationFrequency( s, 4 )
.id 1 0
1 111 0 1
2 011 1 0
3 101 0 0
4 001 1 1
5 110 0 1
6 010 0 1
7 100 0 2
8 000 2 2
permutationFrequency( sample( -1:1, 10, replace = T ), 2 )
.id 1 -1 0
1 1 1 2 0
2 -1 0 1 2
3 0 1 0 2
Прошу прощения у моего учителя по случайным процессам, но проблемы функционального программирования в R были просто более интересными, чем руина игрока сегодня ...