Quickest/Most efficient way to get available times for Scheduler Database - ms-access

Question

I'm creating a database that I want to use to schedule tasks for random 2-hour windows each day within a given date and time range. For instance, Task1 may run from 1 Jan to 12 Jan anytime between the hours of 5am and 5pm. Therefore, the database will schedule the task for a random 2-hour window (to start no earlier than 5am and stop no later than 5pm) on each of those days. It may throw out something like this for Task1:
Date Start_Time Stop_Time
01 Jan 06:32 08:32
02 Jan 14:24 16:24
03 Jan 08:05 10:05
04 Jan 12:17 14:17
05 Jan 11:23 13:23
06 Jan 12:53 14:53
07 Jan 09:11 11:11
08 Jan 05:27 05:27
09 Jan 12:46 14:46
In addition to the conditions for each Task (must be scheduled each day within a date range and within the given time range), no more than 2 tasks can overlap at any given point on any day, and no task can run into the next day (therefore they cannot start after 10pm).
So far, my database does this, albeit slowly, so I'm wanting to know if the method I'm using is the most efficient.
For tables, I have one (tblWindows) which basically just consists of a column called WindowStart populated with each minute of the day, starting at 00:00 and ending at 23:59. Literally, 1440 records -- one record for each minute of the day.
I have another table (tblTaskConfigs) where I have the configs for each task to be scheduled against. This is where I specify the start/stop dates and start/stop times for each Task to be scheduled.
Finally, my tblSchdTasks table keeps track of when tasks are scheduled.
Regarding the operation, it goes something like this:
Open tblTaskConfigs recordset. For each TaskConfig record:
1) Save the following into variables:
- StartDate
- StopDate
- StartTime
- StopTime
2) For each date the task is to be scheduled on:
A) Using DCount on tblSchdTasks, check if that task has already been scheduled for that date:
- Yes: Skip to the next date
- No:
I) Open a query recordset (qryAvailWin) that contains available windows for that date that fall within the TaskConfig's start/stop times (times from tblWindows in which there are no more than 1 task that overlaps those times).
II) Choose a random record from qryAvailWin to determine the start time of the Task to be scheduled.
III) Open a tblSchdTasks recordset and create a new record for the task and it's randomly-selected time for that day.
So, I'm opening up the tblTaskConfigs recordset, and looping through each record. For each of those records, for each day the Task is to be scheduled for, I'm opening up 2 more recordsets (qryAvailWin & tblSchdTasks) to check available times and to actually schedule the task.
For 1 task that lasts 56 days, this operation takes about 108-113 seconds. I suspect it's because it's opening and closing a total of 113 recordsets (1 + (56 x 2)). Additionally, qryAvailWin has three parameters (CurrDate, StartTime, and StopTime) that I need to set before each time it's opened so that it only shows available windows that are relevant to that date and that TaskConfig.
Can you think of a more efficient way of doing something like this?

Answer 1

Had some time to spare, so I coded my approach to the problem.
Since you're not giving me much to work with as to specifics, you will have to fill in a lot of blanks, such as variable names and WHERE criteria.
First, 2 helper functions for picking random numbers and dates:
Public Function RandomRange(Lower As Double, Upper As Double, Optional IncludeDecimals As Boolean = True) As Double
'Returns a random number between Lower and Upper, either with or without decimals
RandomRange = Lower + (Rnd() * (Upper - Lower + IIf(IncludeDecimals, 0, 1)))
If IncludeDecimals = True Then Exit Function
RandomRange = Int(RandomRange)
End Function
Public Function RandomTime(Lower As Date, Upper As Date) As Date
'Returns a random time between Lower and Upper
Dim randomTimeDbl As Double
randomTimeDbl = CDbl(Lower) + (Rnd() * CDbl(Upper - Lower))
RandomTime = CDate(randomTimeDbl)
End Function
Then, the actual logic to schedule tasks for an interval of days:
Public Function ScheduleTasksBetweenDays(StartDate As Date, EndDate As Date, TaskIdentifier As Variant)
'Open the scheduled tasks table
Dim rsSchdTasks As Recordset
Set rsSchdTasks = CurrentDb.OpenRecordset("SELECT * FROM tblSchdTasks SORT BY Date ASC, Start_Time ASC")
'Second recordset for tasks only on a specific date
Dim rsFiltered As Recordset
'Create a collection to save valid start and end dates
Dim startEndDates As Collection
'And create a collection for overlapping times
Dim overlappingTimes As Collection
'Create two arrays to save start-end date pairs
Dim startEndDatePair(2) As Date
Dim previousTaskStartEndTime(2) As Date
'Create an int to hold random values
Dim randomInt As Integer
'Make an iterator for a while loop, and one for the for loop
Dim dateIterator As Date
Dim i As Integer
dateIterator = StartDate
'Iterate through all the dates
While dateIterator < EndDate
'Set rsFiltered to all records of that date
rsSchdTasks.Filter = "Date = #" & Format(dateIterator, "yyyy\/mm\/dd") & "#"
'Open the filtered recordset
Set rsFiltered = rsSchdTasks.OpenRecordset()
'Use the already instantiated recordset instead of a DCount, if the task is already set, next iteration
rsFiltered.FindFirst "TaskIdentifier = " & TaskIdentifier
If Not rsFiltered.NoMatch Then GoTo NextDate
'Start at the first already set taks, iterate through them
rsFiltered.MoveFirst
'Clean up the overlappingTimes collection
Set overlappingTimes = New Collection
'Initialize the first task as the previous one
If Not rsFiltered.EOF Then
previousTaskStartEndTime(1) = rsFiltered.Fields("Start_Time")
previousTaskStartEndTime(2) = rsFiltered.Fields("End_Time")
rsFiltered.MoveNext
End If
Do While Not rsFiltered.EOF
'If the start time of the next task is less than the end time
If previousTaskStartEndTime(2) > rsFiltered.Fields("Start_Time") Then
'The overlapping segment is from end of previous to start of new
startEndDatePair(1) = rsFiltered.Fields("Start_Time")
startEndDatePair(2) = previousTaskStartEndTime(2)
'Add those that interval to the collection of invalid intervals
overlappingTimes.Add startEndDatePair
End If
previousTaskStartEndTime(1) = rsFiltered.Fields("Start_Time")
previousTaskStartEndTime(2) = rsFiltered.Fields("End_Time")
rsFiltered.MoveNext
Loop
'Now, we have a collection of all times that can't overlap with the task
'Lets set the next collection of possible start times
'First possible start time is 5 AM
startEndDatePair(1) = #5:00:00 AM#
'Open up a blank collection of possible valid intervals
Set startEndDates = New Collection
'Next step seems familliar, loop through the invalid times to calculate the valid ones
For i = 1 To overlappingTimes.Count
'If the start of the next task is more than 2 hours away than the possible start time, we can plan it before this task
If startEndDatePair(1) + #2:00:00 AM# < overlappingTimes(i)(1) Then
'Set the maximum start time to 2 hours before the next task
startEndDatePair(2) = overlappingTimes(i)(1) - #2:00:00 AM#
'Add it to the collection of possible times
startEndDates.Add startEndDatePair
End If
'Set the next possible valid interval to be behind this task
startEndDatePair(1) = overlappingTimes(i)(2)
Next i
'All unchanged since last edit here
'Check if we can put our task behind the last one, if so, last possible start time is 10 PM
If startEndDatePair(1) < #10:00:00 PM# Then
'Set it's maximum end time
startEndDatePair(2) = #10:00:00 PM#
startEndDates.Add startEndDatePair
End If
'Now, we have an array with all possible intervals where our task can start at
If startEndDates.Count = 0 Then
'Apparently, this day is already full and we can't plan the task. Do something adequate for that scenario
GoTo NextDate
End If
'pick a random interval from our intervals array
randomInt = RandomRange(1, startEndDates.Count, False)
'Assign our array to that interval
startEndDatePair(1) = startEndDates(randomInt)(1)
startEndDatePair(2) = startEndDates(randomInt)(1)
'update the schdTasks table
rsSchdTasks.Edit
rsSchdTasks.AddNew
rsSchdTasks.Fields("Date") = dateIterator
'Pick a random start time within our interval
rsSchdTasks.Fields("Start_Time") = RandomTime(startEndDatePair(1), startEndDatePair(2))
'End = 2 hours later
rsSchdTasks.Fields("End_Time") = rsSchdTasks.Fields("Start_Time") + #2:00:00 AM#
rsSchdTasks.Fields("TaskIdentifier") = TaskIdentifier
rsSchdTasks.Update
NextDate:
dateIterator = dateIterator + 1
Loop
End Function
As you may note, the improvements include:
You only open up tblSchdTasks once. Per day you filter the open table and put that into a new recordset
You no longer use DCount, but instead check the already opened table
Instead of just picking random times and checking if they are valid, you make a collection of all possible start and end intervals, then pick one of those intervals, then pick a timepoint within that interval
There is no longer any need for the (imho weird) tblWindows
You now include seconds in your start and end dates
You no longer need qryAvailWin, which was searching a giant table and probably taking up a lot of your time
You've gone from opening 113 recordsets and executing 56 DCounts (which are just as heavy as recordsets) to opening 1 recordset, and filtering and searching it 56 times
And a possible disadvantage:
If the intervals are really unequal in size (one is long, another is short) they both have an equal chance to be picked for the tasks. This isn't too hard to fix, but well, I've put in enough effort I think