Функция, которая помещает фрейм данных в «лучший квадрат» в R - PullRequest
Новая
       15

Функция, которая помещает фрейм данных в «лучший квадрат» в R

0 голосов
/ 08 октября 2018

Моя цель состоит в том, чтобы написать функцию в R, которая принимает в качестве входных данных кадр данных и возвращает его «наилучшее квадратное подмножество».

Под лучшим квадратным подмножеством я подразумеваю, что выходные данные должны подтвердить следующее:

  • Все ячейки / элементы выше 2000
  • В нем столько ячеек / элементов, сколько возможно
  • В случае связей (2 кадра данных, которые соответствуют вышеуказанным критериями содержат одинаковое количество ячеек) вернем тот, у которого наибольшая сумма ячеек / элементов

Давайте рассмотрим три следующих примера: 

example1 <- structure(list(Afternoon = c(20800L, 15254L, 17426L, 4391L, 39194L
), Evening = c(21679L, 0L, 2973L, 37L, 435L), Morning = c(0L, 
                                                          3726L, 0L, 0L, 0L)), .Names = c("Afternoon", "Evening", "Morning"
                                                          ), row.names = c("Friday", "Monday", "Thursday", "Tuesday", "Wednesday"
                                                          ), class = "data.frame")

example2 <- structure(list(Afternoon = c(1227364L, 219402L, 3L, 0L, 530891L, 
                                         153124L, 281788L), Evening = c(570618L, 167216L, 31L, 10L, 88702L, 
                                                                        161006L, 42L), Morning = c(0L, 121775L, 0L, 0L, 0L, 25133L, 270162L
                                                                        )), .Names = c("Afternoon", "Evening", "Morning"), row.names = c("Friday", 
                                                                                                                                         "Monday", "Saturday", "Sunday", "Thursday", "Tuesday", "Wednesday"
                                                                        ), class = "data.frame")

example3 <- structure(list(Afternoon = c(20800L, 258L, 300L, 563L, 2000L
), Evening = c(21679L, 0L, 2973L, 37L, 435L), Morning = c(0L, 
                                                          3726L, 0L, 0L, 0L)), .Names = c("Afternoon", "Evening", "Morning"
                                                          ), row.names = c("Friday", "Monday", "Thursday", "Tuesday", "Wednesday"
                                                          ), class = "data.frame")

Это выглядит так:

> example1
          Afternoon Evening Morning
Friday        20800   21679       0
Monday        15254       0    3726
Thursday      17426    2973       0
Tuesday        4391      37       0
Wednesday     39194     435       0

> example2
          Afternoon Evening Morning
Friday      1227364  570618       0
Monday       219402  167216  121775
Saturday          3      31       0
Sunday            0      10       0
Thursday     530891   88702       0
Tuesday      153124  161006   25133
Wednesday    281788      42  270162

> example3
          Afternoon Evening Morning
Friday        20800   21679       0
Monday          258       0    3726
Thursday        300    2973       0
Tuesday         563      37       0
Wednesday      2000     435       0

Функция, которую я ищу, должна подставить вышеупомянутые 3 примера в следующие 3 соответственно: 

> output1
          Afternoon
Friday        20800
Monday        15254
Thursday      17426
Tuesday        4391
Wednesday     39194

Оценка / площадь квадрата равна 5. Все остальное будетбыть меньше.Например, выбор пятницы, вечернего вечера четверга даст 4 

> output2
         Afternoon Evening
Friday     1227364  570618
Monday      219402  167216
Thursday    530891   88702
Tuesday     153124  161006

Здесь кто-то первым подумал бы выбрать все время понедельника, вторника и среды и получить оценку 9. Однако в средупо вечерам 42 подтверждает первый критерий.Понедельник и вторник во все дни и часы дают оценку / площадь 6 

> output3
       Afternoon Evening
Friday     20800   21679

Здесь у нас есть два возможных квадрата, которые подтверждают первые 2 критерия: пятница днем ​​и вечером или пятница и среда днем.Мы должны сделать первый выбор, так как сумма внутри ячеек выше, чем во втором случае.Это правило применяется только в случае галстуков.

1 Ответ

0 голосов
/ 29 октября 2018

Наиболее интуитивным решением было бы просмотреть все возможные комбинации строк и столбцов и проверить, образуют ли выбранные строки и столбцы полный квадрат или нет, если да, то проверьте, составляют ли они наибольшее возможное число.Потенциальная проблема с этим подходом заключается в том, что если у вас много столбцов и строк, потребуется несколько веков, что не является оптимальным.Мой ответ на поставленный здесь вопрос работает достаточно хорошо (на моем ПК с 16 ГБ ОЗУ, 2,7 ГГц ЦП и Windows 10pro 64 бит, R версия 3.5.1), когда количество столбцов и строк не намного больше 12. 

#library(gtools)

find_best_square <- function(x, thresh = 2000){
    # x <- example1
    x[x<thresh] <- 0

    # for larger datasets only: removing lonely cells
    if (ncol(x) > 7 | nrow(x)> 7){
        for (i in 1:nrow(x)){
            for (j in 1:ncol(x)){
                if((colSums(x[,j,drop=F]) == x[i,j]) & (rowSums(x[i,,drop=F])==x[i,j])) x[i, j] <- 0L 
            }
        }
    }

    # remove columns with no data
    is_colZero <- colSums(x==0)== nrow(x)
    if(any(is_colZero)) print(paste('this column is empty and removed: ', which(is_colZero)))
    x <- x[,!is_colZero]

    # remove rows with no data
    is_rowZero <- rowSums(x==0)==ncol(x)
    if(any(is_rowZero)) print(paste('this row is empty and removed: ', which(is_rowZero)))
    x <- x[!is_rowZero,]

    n <- ncol(x)
    m <- nrow(x)
    max_size <- 0L
    max_sum <- 0L
    jump_i <- 0L
    jump_j <- 0L

    for (i in n:1){ # cols
        # all possible combination
        next_max <- m  * (i-1)

        if(max_size!=0 & next_max < max_size &  i * m < max_size) {
            jump_i <- jump_i + 1
            next()
        }
        comb_col <- combinations(n,i)
        for (k in 1:nrow(comb_col)){
            col <- as.integer(comb_col[k,])
            for(j in m:1){ # rows
                if (i*j < max_size ) {
                    jump_j <- jump_j +1
                    next()
                }
                comb_row <- combinations(m,j)
                for (l in 1:nrow(comb_row)){
                    row <- as.integer(comb_row[l,])
                    y <- x[row, col, drop=F]
                    if(all(y > 0) & max_size <= length(row)*length(col)){
                        if(max_size == length(row)*length(col)){
                            if(sum(y) > max_sum){ 
                                max_size <- length(row) * length(col)
                                max_cols <- col
                                max_rows <- row
                                max_sum <- sum(y)}
                        } else {
                            max_size <- length(row) * length(col)
                            max_cols <- col
                            max_rows <- row
                            max_sum <- sum(y) 
                        }

                    }

                }
            }

        }


    }   
    return(x[max_rows,max_cols, drop=F])
}

надеюсь, это будет работать для вас, любой вопрос, пожалуйста, напишите мне.

...