Timetable/Component1.fs at master · RevisionHub/Timetable · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
namespace Timetable
type SpecificTime = {day:int;part:int}
type Tweakables =
    {
        daysBetween : int
        partsPerDay : int
        timeOff : SpecificTime[]
        breaks : int[]
        minimumFraction : int
        maximumFraction : int
        acceptableOffset : int
    }
type Subject =
    {
        subject : string
        difficultyPos:int
        //likePos:int
    }
type Routine =
    |TimeOff = 0
    |Break = 1
    |Work = 2
type TimetableRequest = {days : int;subjects:Subject[];tweakables:Tweakables; routine:(Routine*int)[]}
[<AutoOpen>]
module Core =
    let t a b = (a*60)+b
    //the int in routine is minutes
    let createTimetable(t:TimetableRequest) =
        let conf = t.tweakables
        let routine = t.routine
        let parts =
            Array.init (t.days) (fun (i) ->
                Array.mapi (fun j (r,t) ->
                    let t' = {day=i;part=j}
                    Choice2Of2(if Array.contains t' conf.timeOff then Routine.TimeOff else r),t
                ) routine
            )
        let totalTime = Array.sumBy(Array.sumBy<_,int>(function|Choice2Of2(Routine.Work),i -> i|_ -> 0)) parts
        //now let's form the timetable
        let nodes = t.subjects|>Array.sortBy(fun (i:Subject) -> i.difficultyPos)
        let max = float conf.maximumFraction
        let min = float conf.minimumFraction
        let step = (max-min)/float (nodes.Length-1)
        let v = [|min..step..max|]
        let all = Array.sum v
        let times = Array.map (fun i -> i/all * float totalTime) v
        printfn "%A" times
        //Now we have worked out the perfect amount of time for each one, we can fit them in
        let rec fit (subject:Subject) (slots:(Choice<string,Routine>*int)[][]) (left:float) =
            if left <= float conf.acceptableOffset then slots else
            let s = Seq.indexed slots
            let i =
                Seq.tryPick(fun (i,e) ->
                    Array.tryFindIndex(
                        function
                        |Choice2Of2(Routine.Work),i -> abs(int(left)-i)<conf.acceptableOffset
                        |_->false
                    ) e
                    |> Option.map (fun j -> i,j)
                ) s
            match i with
            |Some(a,b) ->
                let c = Array.copy slots
                let v = snd c.[a].[b]
                c.[a].[b] <- Choice1Of2(subject.subject),v
                c
            |None ->
                //We are going to have to split!
                let j =
                    Seq.tryPick(fun (i,e) ->
                        Array.tryFindIndex(
                            function
                            |Choice2Of2(Routine.Work),i -> int(left)>i
                            |_->false
                        ) e
                        |> Option.map (fun j -> i,j)
                    ) s
                match j with
                |Some(a,b) ->
                    let c = Array.copy slots
                    let v = snd c.[a].[b]
                    c.[a].[b] <- Choice1Of2(subject.subject),v
                    fit subject c (left-(float v))
                |None ->
                    //We have run out of good slots!!!
                    failwith "I need to fix this!"
        Array.fold2(fun acc time subject -> fit subject acc time) parts times t.subjects