Использовать функцию table() как определенную пользователем функцию

Question

x <- c(1,2,3,2,1) 

table(x) 
# x 
# 1 2 3 
# 2 2 1 

Выводит, сколько раз каждый элемент встречается в векторе.

Я пытаюсь подражать выше функции, используя function()

Ниже мой код:

TotalTimes = function(x){ 
    times = 0 
    y = unique(x) 
    for (i in 1:length(y)) { 
    for (i in 1:length(x)) { 
     if(y[i] == x[i]) 
     times = times + 1 
    } 
    return(times) 
    } 
} 

Что бы правильный подход?

Answer 1

Вот один метод с использованием базового R:

# data 
x <- c(1,2,3,2,1) 

# set up 
y <- sort(unique(x)) 
counts <- rep_len(0, length.out=length(y)) 
names(counts) <- y 

for(i in seq_along(x)) { 
    counts[x[i] == y] <- counts[x[i] == y] + 1 
} 

Обертывание его в функции:

table2 <- function(x) { 
    # transform x into character vector to reduce search cost in loop 
    x <- as.character(x) 
    y <- sort(unique(x)) 
    counts <- rep_len(0, length.out=length(y)) 
    names(counts) <- y 

    for(i in seq_along(x)) { 
    counts[x[i]] <- counts[x[i]] + 1L 
    } 
    return(counts) 
} 

Эта версия принимает только один вектор, конечно. По предложению Фрэнка версия функции немного отличается и, возможно, быстрее, поскольку она преобразует входной сигнал x в символ. Потенциальная скорость вверх находится в поиске в counts[x[i]], где имя в counts упоминается (как x [i]), а не выполняет поиск с использованием «==.».

Answer 2

function(x) { 
    q = sapply(unique(x), function(i) sum(x == i)) 
    names(q) = unique(x) 
    return(q) 
} 

Answer 3

Вот один вкладыш, используя rle():

f <- function(x) { 
    with(rle(sort(x)), setNames(lengths, values)) 
} 

f(c(1,2,3,2,1)) 
# 1 2 3 
# 2 2 1 

В качестве альтернативы, вот вариант, который менее «хитрым», и, вероятно, является лучшей моделью для обучения кода в R-иш образом :

f2 <- function(x) { 
    ss <- sort(x) 
    uu <- unique(ss) 
    names(uu) <- uu 
    sapply(uu, function(u) sum(ss == u)) 
} 

f2(c(1,2,3,2,1)) 
# 1 2 3 
# 2 2 1