Жадный алгоритм для получения наибольшего количества очков - PullRequest
Новая
       7

Жадный алгоритм для получения наибольшего количества очков

0 голосов
/ 11 февраля 2019

У меня есть экзамен, где максимальное количество очков - 55, а ограничение по времени - 50 минут.Мне нужно разработать жадный алгоритм в R, чтобы максимизировать количество точек, которые можно получить за выделенное время.

предположения: -100% правильно для попыток ответить на вопросы - если вопрос начался, он должен быть завершен

Я не знаю, как это сделать.

> table[order(table$Points_per_min, decreasing = T),]
  Question Total_Points Time_needed Points_per_min
6       Q6            5           3      1.6666667
5       Q5            5           4      1.2500000
4       Q4           14          12      1.1666667
7       Q7           10          10      1.0000000
8       Q8            5           5      1.0000000
1       Q1           21          24      0.8750000
9       Q9            5           6      0.8333333
2       Q2            5           7      0.7142857
3       Q3           10          15      0.6666667

Я думаю, что, основываясь на расчетах вручную, я должен получить 49 максимальных очков и 47 минут.Я могу ошибаться.Спасибо!

Ответы [ 2 ]

0 голосов
/ 11 февраля 2019

Жадный подход здесь будет заключаться в решении вопросов в порядке убывания точек в минуту .Это не гарантирует, что вы получите наилучшее (оптимальное) решение, предложенное @Chase, но достаточно хорошее.Единственное ограничение - не пересекать сроки.Если в процессе вы найдете вопрос, который нарушает это ограничение, вы пропустите его. 

# Initiate cumulative points 
cum_points <- 0

# Initiate cumulative time used
cum_time <- 0

# Initiating Questions solved/finished in sequence/ index j
question_finished <- as.character()
j <- 1


# sort the data based on Points_per_min
library(dplyr)
df_sorted <- df %>% arrange(desc(Points_per_min)) 

# Checking question by question
for(i in 1:nrow(df_sorted)){

     # only if cumulative time not exceeding time limit of 50 min, we solve a question
     if(cum_time + df_sorted$Time_needed[i] <= 50){
     cum_time <- cum_time + df_sorted$Time_needed[i]
     cum_points <- cum_points + df_sorted$Total_Points[i]

     # Storing the Solved/finished questions and incrementing j
     Question_finished[j] <- as.character(df_sorted$Question[i])
     j <- j + 1

  }
}

Question_finished
#[1] "Q6" "Q5" "Q4" "Q7" "Q8" "Q9" "Q2"
cum_points
#[1] 49
cum_time
#[1] 47

Используемые данные: 

df <- read.table(text = "Question Total_Points Time_needed Points_per_min
6       Q6            5           3      1.6666667
5       Q5            5           4      1.2500000
4       Q4           14          12      1.1666667
7       Q7           10          10      1.0000000
8       Q8            5           5      1.0000000
1       Q1           21          24      0.8750000
9       Q9            5           6      0.8333333
2       Q2            5           7      0.7142857
3       Q3           10          15      0.6666667")
0 голосов
/ 11 февраля 2019

Вы можете установить это как задачу линейной оптимизации.Вы пытаетесь максимизировать количество баллов с учетом временных ограничений.Кроме того, каждая переменная принятия решения должна быть двоичной, поскольку вы не можете ответить на один и тот же вопрос дважды.

lpSolveAPI - это пакет R. для решения этих проблем.Честно говоря, я нахожу синтаксис немного плотным, но очень мощным.Мне удалось найти 50-балльное решение, которое занимает все 50 минут.FWIW, я нашел то же решение в Excel Solver(), что, на мой взгляд, немного более интуитивно.

Полное решение приведено ниже, но вот представление модели, которую мы настроили (этовывод из write.lp() после настройки модели: 

/* Objective function */
max: +21 Q1 +5 Q2 +10 Q3 +14 Q4 +5 Q5 +5 Q6 +10 Q7 +5 Q8 +5 Q9;

/* Constraints */
Time_Constraint: +24 Q1 +7 Q2 +15 Q3 +12 Q4 +4 Q5 +3 Q6 +10 Q7 +5 Q8 +6 Q9 <= 50;

/* Variable bounds */
Q1 <= 1;
Q2 <= 1;
Q3 <= 1;
Q4 <= 1;
Q5 <= 1;
Q6 <= 1;
Q7 <= 1;
Q8 <= 1;
Q9 <= 1;

/* Integer definitions */
int Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9;

library(lpSolveAPI)
library(data.table)

#Define questions, points, and time requirements
dt <- data.table(questions = paste0("Q", 1:9), points = c(21,5,10,14,5,5,10,5,5), time = c(24,7,15,12,4,3,10,5,6))

#make lp object with one contrasint and 9 decision variables
lprec <- make.lp(1,9)
#make sure we're maximizing, not minimizing
lp.control(lprec,sense='max')
#Set the names
dimnames(lprec) <- list("Time_Constraint", dt$questions)
#Set the objective function values, i.e. how many points we get
set.objfn(lprec, dt$points)
#assign the time taken to earn the points
set.row(lprec, 1, dt$time)
#what is the right hand side variable to 50
set.rhs(lprec, 50)
#make the variables binary
set.type(lprec, columns = 1:9, "binary")
#write this model out to see what it is
write.lp(lprec, filename = "model.lp", type = "lp")
#solve the model
solve(lprec)
#> [1] 0
#get the answers, i.e. which should be answered
answers <- get.variables(lprec)
#let's subset just the questions we should answer
dt[as.logical(answers), ]
#>    questions points time
#> 1:        Q1     21   24
#> 2:        Q4     14   12
#> 3:        Q5      5    4
#> 4:        Q7     10   10
#and confirm that we don't go over 50 minutes
dt[as.logical(answers), .(points = sum(points), time_taken = sum(time))]
#>    points time_taken
#> 1:     50         50

Создан в 2019-02-10 пакетом Представить (v0.2.1)

...