2016-07-17 1 views
2

Я пытаюсь создать функцию R, которая выбирает случайную запись среди тех записей, которые имеют значения, равные максимуму, и делают эту строку мудрой , Хитрость заключается в том, что как только я выберу столбец для данной строки, я больше не хочу, чтобы этот столбец рассматривался для выбора для последующих строк. Я также хочу знать, сколько столбцов было записей, которые были равны максимальному количеству роллинга и точно, что это максимальное значение для строки. Я пробовал много вариаций на тему, и вот мой код, как он сейчас. Большой массив - это большая матрица 5000 строк на 20000 столбцов. Я попытался это процитировать, но проблема в том, что это динамический процесс, поэтому результаты для строки 2 зависят от того, какой столбец был выбран для строки 1. Поэтому я не могу просто выбрать максимальные значения строк сразу, потому что они могут измениться.R индексирование матрицы, используемой для определения индексов максимальных значений, занимающих более 8 часов в R

Вот пример из первых двух строк:

Ряд 1: 0,5, 0,5, 1, 1 Ряд 2: 0,6, 0,8, 0,7, 0,9

Так я знайте, что rowmax для строки 1 равен 1, а строка max для строки 2 - .9. Но если я выберу четвертый столбец (из третьего и четвертого из строки 1), я удаляю этот столбец из возможного выбора для строки 2 (у которого теперь есть кандидаты .6, .8, .7)

Я борюсь с как сделать это более эффективным. Любой совет будет принят во внимание. Вы все мастера, и я пытаюсь стать им. Поэтому любой совет так высоко ценится!

Вот мой текущий код Р:

function(largemat, reordervector, IDvector) 
nrowz<-nrow(largemat) 
maxvalues<-numeric(nrowz) 
numberofmaxes<-integer(nrowz) 
idvalue<-integer(nrowz) 

#this line randomizes the order of the rows 
tempmat<-largemat[reordervector,] 
tempsims<-NULL 
for (i in 1:nrowz){ 
tempsims<-which(tempmat[i,]==max(tempmat[i,])) 
numberofmaxes[i]<-length(tempsims) 
tempindx<-ifelse(length(tempsims)==1, tempsims, sample(x=tempsims, size=1)) 
#pick off the largest value 
distvalues[i]<-tempmat[i, tempindx] 
# record the column id name of the largest value 
idvalue[i]<-IDvector[tempindx] 
#remove the column so that it cannot be selected again 
tempmat<-tempmat[,-tempindx] 

list(nm=numberofmaxes, dv=distvalues, ids=idvalue) 
} 

Функция будет генерировать три вектора каждые из длины nrow (largemat) производит количество Maxes для каждой строки, имя идентификатора позиции столбца, в котором max для данной строки и значение максимума из исходной матрицы.

Вот небольшой пример:

largemat является матрицей:

largemat<-rbind(c(.2 .5 .6 .8 .9 1 1 1), 
       c(.3 .4 .8 .9 1 .7 1 1), 
       c(.5 1 .6 .6 .9 .9 .8 .1)) 

Предположим, эта матрица уже переставлены строки (так reordervector уже был применен к largemat)

первый шаг : определить, какие столбцы имеют наибольшее значение для строки 1: (6, 7, 8) второй шаг: случайным образом выбрать один из этих столбцов (скажем, 7) третий шаг: значения идентификатора захвата, соответствующие вектору имени идентификатора для столбца 7 (И записать максимальное значение для строки 1, на самом деле 1) четвертого шага: сжать матрицу, чтобы исключить столбец 7 для дальнейшего рассмотрения и повторить шаги по строке 2 новой матрица:

largemat<-rbind(c(.2 .5 .6 .8 .9 1 1), 
       c(.3 .4 .8 .9 1 1 1), 
       c(.5 1 .6 .6 .9 .8 .1)) 

continue- в результате векторы идентификаторов будут такими, как maxes: 1 и т. д. ids: col7id и т. д. (интерпретация столбцов для идентификаторов столбцов) Число максимумов должно быть: 3 и т. д. (что соответствует количеству столбцов для данной строки, которая было максимальное значение для этой строки)

+0

вы должны добавить данные выборки и ожидаемые результаты: http://stackoverflow.com/questions/5963269/how-to-make-a-great-r- воспроизводимый пример – Bulat

+0

Благодарим за предложение. Все еще относительно новый для переполнения стека для публикации. Я просто добавил небольшой пример. Не удалось выяснить, как подключить данные, поэтому я просто использовал что-то маленькое. Конечно, это будет работать очень быстро, но на моих больших матрицах требуется более 8 часов для работы через 5000 на 20000 больших массивов. У меня есть –

+0

Является ли 'nonprobmatID' как аргумент' IDvector'? 'IDvector' не используется внутри функции. – bgoldst

ответ

2

Я бы создал вспомогательные функции для выполнения задачи. Ваше использование ifelse проблематично в создании temp. Использование if является более подходящим. Данные.Выходной рама самый смысл для меня:

choose.max <- function(x, omit=NULL) { 
    x[omit] <- -Inf 
    xmax  <- which(x == max(x)) 
    x_col <- if(length(xmax) == 1L) xmax else sample(xmax, size=1L) 
    x_value <- max(x) 
    num_maxes <- length(xmax) 
    return(data.frame(col=x_col, max_value=x_value, num_maxes=num_maxes)) 
} 

max_choice <- function(df) { 
    res <- list(choose.max(df[1,,drop=FALSE])) 

    for(i in 2:nrow(df)) { 
    res[[i]] <- choose.max(x=df[i,,drop=FALSE], omit=sapply(res, '[[', "col")) 
    } 

    return(do.call("rbind", res)) 
} 

Вызов функции max_choice создаст фрейм данных, первый столбец для максимального столбца, выбранного, то максимальное значение этой строки, а количество Maxes:

set.seed(143) 
mat <- matrix(sample(1:5, 16, TRUE), 4, 4) 
max_choice(mat) 
# col max_value num_maxes 
# 1 1   5   2 
# 2 2   5   1 
# 3 4   5   1 
# 4 3   1   1 

Редактировать

Если скорость важна, вы можете получить импульс с этим редактирования:

max_choice <- function(df) { 
    res <- vector("list", nrow(df)) 
    res[[1]] <- choose.max(df[1,,drop=FALSE]) 

    for(i in 2:nrow(df)) { 
    res[[i]] <- choose.max(x=df[i,,drop=FALSE], omit=sapply(res[!sapply(res,is.null)], '[[', "col")) 
    } 

    return(do.call("rbind", res)) 
} 

Edit 2

Это может быть даже еще быстрее. parallel встроенный в пакет для параллельной обработки:

library(parallel) 
no_cores <- detectCores() - 1 
cl <- makeCluster(no_cores) 
clusterExport(cl, c("mat", "choose.max", "max_choice")) 
fast_res <- parLapply(cl, 1, function(x) max_choice(mat))[[1]] 
+0

Я попробую это и отчитаю. Надеюсь, это ускорит ситуацию. Сейчас очень медленно, как у меня. Большое вам спасибо за ваши предложения и помощь! –

+0

Спасибо за это. Мне трудно найти параллельный пакет в R. Я использую 3.2.5. Недоступно ли для этой версии R? НИКОГДА не думай об этом! –

+0

Это должно быть. Что происходит, когда вы вводите 'library (parallel)'? –