1 | Attribute VB_Name = "modGAP" |
---|
2 | '-------------------------------------------------------------------------------- |
---|
3 | ' RACE 4.0 - |
---|
4 | '-------------------------------------------------------------------------------- |
---|
5 | ' File: - |
---|
6 | ' modGAP.bas - |
---|
7 | ' Purpose: - |
---|
8 | ' Module for computing GAP results. - |
---|
9 | ' Comments: - |
---|
10 | ' All distances in km. - |
---|
11 | ' Goal = Goal of distance measuring - |
---|
12 | ' ES = End of speed section - |
---|
13 | ' History: - |
---|
14 | ' 20.10.99 ACM Created - |
---|
15 | ' 07.02.02 LG Updated according Angelo Crapanzano (GAP 2002 Implemented) - |
---|
16 | '-------------------------------------------------------------------------------- |
---|
17 | |
---|
18 | Option Explicit |
---|
19 | |
---|
20 | '-------------------------------------------------------------------------------- |
---|
21 | ' Globals - |
---|
22 | '-------------------------------------------------------------------------------- |
---|
23 | |
---|
24 | 'Values needed for calculation |
---|
25 | 'Counter |
---|
26 | Public m_nPilotsTotal As Long 'All pilots registered |
---|
27 | Public m_nPilotsLaunched As Long 'Pilots who took off |
---|
28 | Public m_nPilotsGoal As Long 'Pilots reached goal (of distance) |
---|
29 | Public m_nPilotsES As Long 'Pilots reached ES (of time) |
---|
30 | Public m_nPilotsLO As Long 'Pilots who landed out |
---|
31 | Public m_nPilotsABS As Long 'Pilots who were absent |
---|
32 | Public m_nPilotsDNF As Long 'Pilots who did not fly |
---|
33 | Public m_nPilotsPresent As Long 'Pilots who were present at start |
---|
34 | Public m_nPilotsMinimumDistance As Long 'Pilots who did not reach min distance |
---|
35 | Public m_nPilotsWithSpeedScore As Long 'Pilots who did get speed score |
---|
36 | |
---|
37 | 'Tops |
---|
38 | Public m_fTopSpeed As Double 'Top speed flown |
---|
39 | Public m_fTopDistance As Double 'Top distance flown |
---|
40 | Public m_dtmTopTime As Date 'Top time flown |
---|
41 | Public m_dtmTimeFirstInES As Date 'Earliest ES time |
---|
42 | Public m_dtmTimeFirstTakeoffWithES As Date 'First takeoff time with ES reached |
---|
43 | Public m_fSmallestLeadingCoefficient As Double 'Smallest Leading Coefficient (GAP 2002) |
---|
44 | Public m_bLCFieldIsUsed As Boolean |
---|
45 | |
---|
46 | 'Distance Sums |
---|
47 | Public m_fSumDistance As Double 'Sum of all distances flown |
---|
48 | Public m_fSumDistanceNominal As Double 'Sum of all distances greater nominal distance (as difference to nominal distance) |
---|
49 | Public m_fSumDistanceMinimum As Double 'Sum of all distances greater minimum distance (as difference to minimum distance) |
---|
50 | Public m_fAverageDistance As Double 'Average of all distances flown |
---|
51 | |
---|
52 | 'Coefficients for day quality |
---|
53 | Public m_fCDistance As Double 'see GAP documentation |
---|
54 | Public m_fCLaunch As Double |
---|
55 | Public m_fCTime As Double |
---|
56 | Public m_fDayQuality As Double |
---|
57 | |
---|
58 | 'Score distribution |
---|
59 | Public m_fDistanceWeight As Double 'see GAP documentation |
---|
60 | Public m_fTaskWeight As Double |
---|
61 | Public m_fAvailableScoreDistance As Double |
---|
62 | Public m_fAvailableScoreTime As Double |
---|
63 | Public m_fAvailableScoreDeparture As Double |
---|
64 | Public m_fAvailableScoreArrival As Double |
---|
65 | Public m_fAvailableScoreTotal As Double |
---|
66 | Public m_fMaxScoreTotal As Double |
---|
67 | |
---|
68 | 'Pilots |
---|
69 | Public m_strPilotWithTopSpeed As String 'Pilot with top speed |
---|
70 | Public m_strPilotFirstES As String 'Pilot who first reached ES |
---|
71 | Public m_strPilotFirstTakeoffWithES As String 'Pilot who first took off and reached ES |
---|
72 | |
---|
73 | '-------------------------------------------------------------------------------- |
---|
74 | ' Types - |
---|
75 | '-------------------------------------------------------------------------------- |
---|
76 | |
---|
77 | 'Type for GAP distance array |
---|
78 | Public Type DistanceArrayEntry |
---|
79 | nLanded As Long |
---|
80 | nLandedFullKM As Long |
---|
81 | nDifficulty As Long |
---|
82 | fRelDiff As Double |
---|
83 | fScorePercent As Double |
---|
84 | End Type |
---|
85 | |
---|
86 | '-------------------------------------------------------------------------------- |
---|
87 | ' ComputePreValues - |
---|
88 | '-------------------------------------------------------------------------------- |
---|
89 | ' Computes all the values needed as input for the formula or to show in the - |
---|
90 | ' reports statistics page. - |
---|
91 | '-------------------------------------------------------------------------------- |
---|
92 | |
---|
93 | Public Sub ComputePreValues(rsTask As DAO.Recordset, _ |
---|
94 | rsResults As DAO.Recordset, _ |
---|
95 | fMinimumDistance As Double, _ |
---|
96 | fNominalDistance As Double, _ |
---|
97 | fNominalTime As Double, _ |
---|
98 | fNominalGoal As Double, _ |
---|
99 | lTaskDistanceFlag As Long, _ |
---|
100 | lTaskSpeedFlag As Long, _ |
---|
101 | lDepartureFlag As Long, _ |
---|
102 | lArrivalFlag As Long, _ |
---|
103 | lGAPVersion As Long) |
---|
104 | |
---|
105 | Dim strStatus As String |
---|
106 | Dim bESReached As Boolean |
---|
107 | Dim fDistance As Double |
---|
108 | Dim dtmTimeSS As Date |
---|
109 | Dim dtmTimeES As Date |
---|
110 | Dim dtmTimeFlight As Date |
---|
111 | Dim dtmTimeFirstInES As Date |
---|
112 | Dim dblTimeLimitSpeedScore As Double |
---|
113 | Dim k As Double |
---|
114 | Dim fLeadingCoefficient As Double 'GAP 2002 |
---|
115 | Dim fLCTemp As Double |
---|
116 | Dim j As Integer |
---|
117 | Dim fLeadingVal As Double |
---|
118 | Dim fSumLeadingVal As Double |
---|
119 | Dim bLeadingValsAreGood As Boolean |
---|
120 | |
---|
121 | Dim bFieldLCIsFound As Boolean |
---|
122 | |
---|
123 | 'Reset values |
---|
124 | ResetPreValues |
---|
125 | |
---|
126 | fLCTemp = 0 |
---|
127 | fLeadingVal = 0# |
---|
128 | fSumLeadingVal = 0# |
---|
129 | bLeadingValsAreGood = False |
---|
130 | 'GAP 2002 |
---|
131 | 'Looking for field resLeadingPosition in rsResults |
---|
132 | |
---|
133 | bFieldLCIsFound = False |
---|
134 | For j = 0 To rsResults.Fields.Count - 1 |
---|
135 | If rsResults.Fields(j).Name = "resLeadingCoeff" Then |
---|
136 | bFieldLCIsFound = True |
---|
137 | bLeadingValsAreGood = True |
---|
138 | j = rsResults.Fields.Count |
---|
139 | End If |
---|
140 | Next j |
---|
141 | |
---|
142 | 'loop over all pilots |
---|
143 | rsResults.MoveFirst |
---|
144 | While Not rsResults.EOF |
---|
145 | |
---|
146 | bESReached = rsResults.Fields("resReachedES").Value |
---|
147 | strStatus = rsResults.Fields("resStatus").Value |
---|
148 | dtmTimeSS = Null2EmptyTime(rsResults.Fields("resSSTime").Value) |
---|
149 | dtmTimeES = Null2EmptyTime(rsResults.Fields("resESTime").Value) |
---|
150 | dtmTimeFlight = Null2EmptyTime(rsResults.Fields("resTime").Value) |
---|
151 | fDistance = rsResults.Fields("resDistance").Value |
---|
152 | |
---|
153 | 'set counter |
---|
154 | Select Case strStatus |
---|
155 | Case "ABS" |
---|
156 | m_nPilotsABS = m_nPilotsABS + 1 |
---|
157 | Case "DNF" |
---|
158 | m_nPilotsDNF = m_nPilotsDNF + 1 |
---|
159 | m_nPilotsPresent = m_nPilotsPresent + 1 |
---|
160 | Case "LO" |
---|
161 | m_nPilotsLO = m_nPilotsLO + 1 |
---|
162 | m_nPilotsPresent = m_nPilotsPresent + 1 |
---|
163 | m_nPilotsLaunched = m_nPilotsLaunched + 1 |
---|
164 | If rsResults.Fields("resCommentCompute").Value = 1 Then m_nPilotsMinimumDistance = m_nPilotsMinimumDistance + 1 |
---|
165 | Case "GOAL" |
---|
166 | m_nPilotsGoal = m_nPilotsGoal + 1 |
---|
167 | m_nPilotsPresent = m_nPilotsPresent + 1 |
---|
168 | m_nPilotsLaunched = m_nPilotsLaunched + 1 |
---|
169 | End Select |
---|
170 | |
---|
171 | If strStatus = "LO" Or strStatus = "GOAL" Then |
---|
172 | |
---|
173 | 'top distance |
---|
174 | If fDistance > m_fTopDistance Then m_fTopDistance = fDistance |
---|
175 | |
---|
176 | 'compute distance sums |
---|
177 | m_fSumDistance = m_fSumDistance + fDistance |
---|
178 | |
---|
179 | If fDistance > fNominalDistance Then |
---|
180 | m_fSumDistanceNominal = m_fSumDistanceNominal + (fDistance - fNominalDistance) |
---|
181 | End If |
---|
182 | |
---|
183 | If fDistance > fMinimumDistance Then |
---|
184 | m_fSumDistanceMinimum = m_fSumDistanceMinimum + (fDistance - fMinimumDistance) |
---|
185 | End If |
---|
186 | |
---|
187 | If (bFieldLCIsFound) And IsNull(rsResults.Fields("resLeadingCoeff").Value) = False Then |
---|
188 | fLeadingVal = rsResults.Fields("resLeadingCoeff").Value |
---|
189 | fSumLeadingVal = fSumLeadingVal + fLeadingVal |
---|
190 | If (fLeadingVal < 0 Or fLeadingVal > 24) Then |
---|
191 | bLeadingValsAreGood = False |
---|
192 | End If |
---|
193 | End If |
---|
194 | |
---|
195 | 'Smallest Leading Coefficient |
---|
196 | If (bFieldLCIsFound) Then |
---|
197 | If rsResults.Fields("resLeadingCoeff").Value > 0 Then |
---|
198 | fLeadingVal = rsResults.Fields("resLeadingCoeff").Value |
---|
199 | If (fLeadingVal > 0) Then |
---|
200 | If (fLeadingVal < fLCTemp Or fLCTemp = 0) Then |
---|
201 | fLCTemp = fLeadingVal |
---|
202 | End If |
---|
203 | End If |
---|
204 | End If |
---|
205 | Else |
---|
206 | If dtmTimeFlight <> dtmEmptyDate Then |
---|
207 | If ((DecimalTimeFromDate(dtmTimeSS) + DecimalTimeFromDate(dtmTimeES)) < fLCTemp Or fLCTemp = 0) Then |
---|
208 | fLCTemp = DecimalTimeFromDate(dtmTimeSS) + DecimalTimeFromDate(dtmTimeES) |
---|
209 | End If |
---|
210 | End If |
---|
211 | End If |
---|
212 | |
---|
213 | 'save best ES time |
---|
214 | If bESReached Then |
---|
215 | |
---|
216 | m_nPilotsES = m_nPilotsES + 1 |
---|
217 | |
---|
218 | If dtmTimeES <> dtmEmptyDate And (m_dtmTimeFirstInES = dtmEmptyDate Or dtmTimeES < m_dtmTimeFirstInES) Then |
---|
219 | m_dtmTimeFirstInES = dtmTimeES |
---|
220 | m_strPilotFirstES = rsResults.Fields("pilFirstName").Value + " " + rsResults.Fields("pilLastName").Value |
---|
221 | End If |
---|
222 | |
---|
223 | |
---|
224 | 'top time/speed |
---|
225 | If dtmTimeFlight <> dtmEmptyDate And (m_dtmTopTime = dtmEmptyDate Or dtmTimeFlight < m_dtmTopTime) Then |
---|
226 | m_dtmTopTime = dtmTimeFlight |
---|
227 | m_fTopSpeed = rsResults.Fields("resSpeed").Value |
---|
228 | m_strPilotWithTopSpeed = rsResults.Fields("pilFirstName").Value + " " + rsResults.Fields("pilLastName").Value |
---|
229 | End If |
---|
230 | |
---|
231 | 'Earliest start time with ES reached |
---|
232 | If dtmTimeFlight <> dtmEmptyDate And _ |
---|
233 | (m_dtmTimeFirstTakeoffWithES = dtmEmptyDate Or dtmTimeSS < m_dtmTimeFirstTakeoffWithES) Then |
---|
234 | m_dtmTimeFirstTakeoffWithES = dtmTimeSS |
---|
235 | 'Don't set pilot if all pilots have same start time |
---|
236 | If rsTask.Fields("tasTaskType").Value = "S" Then |
---|
237 | m_strPilotFirstTakeoffWithES = rsResults.Fields("pilFirstName").Value + " " + rsResults.Fields("pilLastName").Value |
---|
238 | End If |
---|
239 | End If |
---|
240 | |
---|
241 | End If |
---|
242 | |
---|
243 | End If |
---|
244 | |
---|
245 | rsResults.MoveNext |
---|
246 | |
---|
247 | Wend |
---|
248 | |
---|
249 | If fSumLeadingVal = 0 Or bLeadingValsAreGood = False Or fLCTemp = 0 Then |
---|
250 | bFieldLCIsFound = False |
---|
251 | End If |
---|
252 | |
---|
253 | If (bFieldLCIsFound) Then |
---|
254 | m_fSmallestLeadingCoefficient = fLCTemp |
---|
255 | m_bLCFieldIsUsed = True |
---|
256 | Else |
---|
257 | m_fSmallestLeadingCoefficient = fLCTemp - (2 * DecimalTimeFromDate(m_dtmTimeFirstTakeoffWithES)) |
---|
258 | m_bLCFieldIsUsed = False |
---|
259 | End If |
---|
260 | |
---|
261 | 'now loop over all pilots to get all pilots with speed score |
---|
262 | dblTimeLimitSpeedScore = CDate(DecimalTimeFromDate(m_dtmTopTime) + Sqr(DecimalTimeFromDate(m_dtmTopTime))) |
---|
263 | rsResults.MoveFirst |
---|
264 | While Not rsResults.EOF |
---|
265 | dtmTimeFlight = Null2EmptyTime(rsResults.Fields("resTime").Value) |
---|
266 | If dtmTimeFlight <> dtmEmptyDate Then |
---|
267 | If (rsResults.Fields("resStatus").Value = "LO" Or rsResults.Fields("resStatus").Value = "GOAL") And (DecimalTimeFromDate(dtmTimeFlight) < dblTimeLimitSpeedScore) Then |
---|
268 | m_nPilotsWithSpeedScore = m_nPilotsWithSpeedScore + 1 |
---|
269 | End If |
---|
270 | End If |
---|
271 | rsResults.MoveNext |
---|
272 | Wend |
---|
273 | |
---|
274 | 'some computing |
---|
275 | m_nPilotsTotal = rsResults.RecordCount |
---|
276 | If m_nPilotsLaunched <> 0 Then |
---|
277 | m_fAverageDistance = m_fSumDistance / m_nPilotsLaunched |
---|
278 | Else |
---|
279 | m_fAverageDistance = 0# |
---|
280 | End If |
---|
281 | |
---|
282 | 'C launch |
---|
283 | If m_nPilotsPresent <> 0 Then |
---|
284 | k = m_nPilotsLaunched / m_nPilotsPresent |
---|
285 | m_fCLaunch = 0.028 * k + 2.917 * (k * k) - 1.944 * (k * k * k) |
---|
286 | Else |
---|
287 | m_fCLaunch = 0# |
---|
288 | End If |
---|
289 | |
---|
290 | If m_fCLaunch < 0# Then m_fCLaunch = 0# |
---|
291 | If m_fCLaunch > 1# Then m_fCLaunch = 1# |
---|
292 | |
---|
293 | 'C Distance |
---|
294 | If fNominalDistance <> fMinimumDistance And m_nPilotsLaunched <> 0 And lTaskDistanceFlag = 1 Then |
---|
295 | |
---|
296 | m_fCDistance = m_fSumDistanceMinimum / (m_nPilotsLaunched / 2# * ((fNominalGoal / 100# + 1#) * (fNominalDistance - fMinimumDistance) + fNominalGoal / 100# * (m_fTopDistance - fNominalDistance))) |
---|
297 | |
---|
298 | ElseIf lTaskDistanceFlag = 0 Then |
---|
299 | m_fCDistance = 1# |
---|
300 | Else |
---|
301 | m_fCDistance = 0# |
---|
302 | End If |
---|
303 | |
---|
304 | If m_fCDistance < 0# Then m_fCDistance = 0# |
---|
305 | If m_fCDistance > 1# Then m_fCDistance = 1# |
---|
306 | |
---|
307 | 'C Time |
---|
308 | Dim fTopTimeUsed As Double |
---|
309 | fTopTimeUsed = DecimalTimeFromDate(m_dtmTopTime) |
---|
310 | |
---|
311 | If m_nPilotsES = 0 And fNominalDistance <> 0# Then |
---|
312 | fTopTimeUsed = fNominalTime * m_fTopDistance / fNominalDistance |
---|
313 | End If |
---|
314 | |
---|
315 | If fNominalTime > 0# And fTopTimeUsed < fNominalTime And lTaskSpeedFlag = 1 Then |
---|
316 | k = fTopTimeUsed / fNominalTime |
---|
317 | m_fCTime = -0.271 + 2.912 * k - 2.098 * (k ^ 2) + 0.457 * (k ^ 3) |
---|
318 | Else |
---|
319 | m_fCTime = 1# |
---|
320 | End If |
---|
321 | |
---|
322 | If m_fCTime < 0# Then m_fCTime = 0# |
---|
323 | If m_fCTime > 1# Then m_fCTime = 1# |
---|
324 | |
---|
325 | 'Day Quality |
---|
326 | m_fDayQuality = m_fCLaunch * m_fCDistance * m_fCTime |
---|
327 | If m_fDayQuality > 1# Then m_fDayQuality = 1# |
---|
328 | |
---|
329 | 'Score distribution |
---|
330 | If m_nPilotsLaunched <> 0 Then |
---|
331 | |
---|
332 | If lGAPVersion >= 2000 Then |
---|
333 | k = m_nPilotsWithSpeedScore / m_nPilotsLaunched |
---|
334 | m_fDistanceWeight = 0.9 - 1.665 * k + 1.713 * k * k - 0.587 * k * k * k |
---|
335 | Else |
---|
336 | k = m_nPilotsES / m_nPilotsLaunched |
---|
337 | m_fDistanceWeight = 0.9 - 1.52 * k + 1.243 * k * k - 0.423 * k * k * k |
---|
338 | End If |
---|
339 | |
---|
340 | m_fAvailableScoreDistance = 1000# * m_fDayQuality * m_fDistanceWeight |
---|
341 | m_fAvailableScoreArrival = 1000# * m_fDayQuality * (1 - m_fDistanceWeight) * 1 / 8 |
---|
342 | |
---|
343 | If lGAPVersion >= 2000 Then |
---|
344 | m_fAvailableScoreDeparture = m_fAvailableScoreArrival * 1.4 |
---|
345 | Else |
---|
346 | m_fAvailableScoreDeparture = m_fAvailableScoreArrival * 1.2 |
---|
347 | End If |
---|
348 | |
---|
349 | If lGAPVersion >= 2002 And lDepartureFlag = 0 Then |
---|
350 | m_fAvailableScoreDeparture = 0# |
---|
351 | End If |
---|
352 | |
---|
353 | If lGAPVersion >= 2002 And lArrivalFlag = 0 Then |
---|
354 | m_fAvailableScoreArrival = 0# |
---|
355 | End If |
---|
356 | |
---|
357 | m_fAvailableScoreTime = 1000# * m_fDayQuality * (1 - m_fDistanceWeight) - m_fAvailableScoreArrival - m_fAvailableScoreDeparture |
---|
358 | m_fAvailableScoreTotal = m_fAvailableScoreDistance + m_fAvailableScoreArrival + m_fAvailableScoreDeparture + m_fAvailableScoreTime |
---|
359 | |
---|
360 | End If |
---|
361 | |
---|
362 | End Sub |
---|
363 | |
---|
364 | '-------------------------------------------------------------------------------- |
---|
365 | ' BuildDistanceArray - |
---|
366 | '-------------------------------------------------------------------------------- |
---|
367 | ' Build the distance array, needed to get distance score. - |
---|
368 | '-------------------------------------------------------------------------------- |
---|
369 | |
---|
370 | Public Function BuildDistanceArray(rsResults As DAO.Recordset, fMinimumDistance As Double) As DistanceArrayEntry() |
---|
371 | |
---|
372 | Dim i As Long |
---|
373 | Dim j As Long |
---|
374 | Dim aDistanceArray() As DistanceArrayEntry |
---|
375 | Dim W As Long |
---|
376 | Dim fSumDifficulty As Double |
---|
377 | Dim fSumRelDifficulty As Double |
---|
378 | Dim nKM As Long |
---|
379 | Dim nKMRounded As Long |
---|
380 | Dim nIndexMinimumDistance As Long |
---|
381 | |
---|
382 | 'Compute W |
---|
383 | If m_nPilotsLaunched <> m_nPilotsGoal Then |
---|
384 | W = Round((3 * m_fTopDistance / m_nPilotsLO), 0) |
---|
385 | Else |
---|
386 | W = 3 |
---|
387 | End If |
---|
388 | |
---|
389 | If W < 3 Then W = 3 |
---|
390 | |
---|
391 | 'Build Score Array |
---|
392 | If m_fTopDistance <> 0# Then |
---|
393 | |
---|
394 | nKM = m_fTopDistance * 10# + 0.01 |
---|
395 | nKMRounded = (Int(m_fTopDistance + 1#)) * 10# + 0.01 |
---|
396 | |
---|
397 | ReDim aDistanceArray(nKMRounded + 1) |
---|
398 | |
---|
399 | 'Count landed pilots |
---|
400 | rsResults.MoveFirst |
---|
401 | While Not rsResults.EOF |
---|
402 | |
---|
403 | If rsResults.Fields("resStatus").Value = "LO" Then |
---|
404 | i = rsResults.Fields("resDistance").Value * 10# + 0.01 |
---|
405 | aDistanceArray(i).nLanded = aDistanceArray(i).nLanded + 1 |
---|
406 | End If |
---|
407 | |
---|
408 | rsResults.MoveNext |
---|
409 | |
---|
410 | Wend |
---|
411 | |
---|
412 | 'Compute LandedFullKM |
---|
413 | j = 0 |
---|
414 | For i = 0 To nKMRounded |
---|
415 | j = j + aDistanceArray(i).nLanded |
---|
416 | If i Mod 10 = 0 Then |
---|
417 | aDistanceArray(i).nLandedFullKM = j |
---|
418 | j = 0 |
---|
419 | End If |
---|
420 | Next i |
---|
421 | |
---|
422 | 'Compute Difficulty |
---|
423 | For i = 0 To nKMRounded |
---|
424 | j = i |
---|
425 | While (j < i + (W * 10)) And (j <= nKMRounded) |
---|
426 | aDistanceArray(i).nDifficulty = aDistanceArray(i).nDifficulty + aDistanceArray(j).nLanded |
---|
427 | j = j + 1 |
---|
428 | Wend |
---|
429 | Next i |
---|
430 | |
---|
431 | 'Build sum of difficulty |
---|
432 | fSumDifficulty = 0# |
---|
433 | For i = 0 To nKM |
---|
434 | fSumDifficulty = fSumDifficulty + aDistanceArray(i).nDifficulty |
---|
435 | Next i |
---|
436 | |
---|
437 | 'Compute relative difficulty |
---|
438 | If fSumDifficulty <> 0# Then |
---|
439 | For i = 0 To nKM |
---|
440 | aDistanceArray(i).fRelDiff = aDistanceArray(i).nDifficulty / (2 * fSumDifficulty) |
---|
441 | Next |
---|
442 | End If |
---|
443 | |
---|
444 | 'Compute score % |
---|
445 | fSumRelDifficulty = 0 |
---|
446 | For i = 0 To nKMRounded |
---|
447 | fSumRelDifficulty = fSumRelDifficulty + aDistanceArray(i).fRelDiff |
---|
448 | aDistanceArray(i).fScorePercent = fSumRelDifficulty |
---|
449 | Next i |
---|
450 | |
---|
451 | 'set score to all distances below or equal minimum distance |
---|
452 | nIndexMinimumDistance = fMinimumDistance * 10# + 0.01 |
---|
453 | For i = nIndexMinimumDistance - 1 To 0 Step -1 |
---|
454 | aDistanceArray(i).fScorePercent = aDistanceArray(nIndexMinimumDistance).fScorePercent |
---|
455 | Next i |
---|
456 | |
---|
457 | 'output of distance array as csv for testing purposes |
---|
458 | |
---|
459 | 'Dim nDistanceInt As Integer |
---|
460 | 'Dim fDistanceRemainder As Double |
---|
461 | 'Dim fPercentTopDistance As Double |
---|
462 | |
---|
463 | 'nDistanceInt = Int(m_fTopDistance) |
---|
464 | 'fDistanceRemainder = m_fTopDistance - nDistanceInt |
---|
465 | |
---|
466 | 'Open "distance.csv" For Output As #1 |
---|
467 | 'Print #1, "Distance Score Array" |
---|
468 | 'Print #1, "Dmax = " + Format(m_fTopDistance, "###0.000") |
---|
469 | 'Print #1, "Range = " + Str(W) |
---|
470 | 'Print #1, "Dmin = " + Format(fMinimumDistance, "###0.000") |
---|
471 | 'Print #1, "sum(difficulty) = " + Format(fSumDifficulty, "###0.000") |
---|
472 | 'Print #1, "km;landed;landed full km;difficulty;rel. difficulty;score %" |
---|
473 | 'For i = 0 To nKMRounded |
---|
474 | ' Print #1, Format(i / 10#, "###0.0") + ";" + _ |
---|
475 | ' Str(aDistanceArray(i).nLanded) + ";" + _ |
---|
476 | ' Str(aDistanceArray(i).nLandedFullKM) + ";" + _ |
---|
477 | ' Str(aDistanceArray(i).nDifficulty) + ";" + _ |
---|
478 | ' Format(aDistanceArray(i).fRelDiff, "###0.000000") + ";" + _ |
---|
479 | ' Format(aDistanceArray(i).fScorePercent, "###0.000000") |
---|
480 | 'Next i |
---|
481 | 'Print #1, ";;;" + Str(Int(fSumDifficulty)) |
---|
482 | 'Close #1 |
---|
483 | |
---|
484 | End If |
---|
485 | |
---|
486 | BuildDistanceArray = aDistanceArray |
---|
487 | |
---|
488 | End Function |
---|
489 | |
---|
490 | '-------------------------------------------------------------------------------- |
---|
491 | ' ComputePilotScore - |
---|
492 | '-------------------------------------------------------------------------------- |
---|
493 | ' Give score to the pilots. - |
---|
494 | '-------------------------------------------------------------------------------- |
---|
495 | |
---|
496 | Public Sub ComputePilotScore(rsTask As DAO.Recordset, _ |
---|
497 | rsResults As DAO.Recordset, _ |
---|
498 | aDistanceArray() As DistanceArrayEntry, _ |
---|
499 | fNominalTime As Double, _ |
---|
500 | lTaskDistanceFlag As Long, _ |
---|
501 | lTaskSpeedFlag As Long, _ |
---|
502 | lTaskDepartureFlag As Long, _ |
---|
503 | lTaskArrivalFlag As Long, _ |
---|
504 | lGAPVersion As Long, _ |
---|
505 | lGoalPenalty As Long) |
---|
506 | |
---|
507 | Dim strStatus As String |
---|
508 | Dim fScoreDistance As Double |
---|
509 | Dim fScoreTime As Double |
---|
510 | Dim fScoreDeparture As Double |
---|
511 | Dim fScoreArrival As Double |
---|
512 | Dim fScoreTotal As Double |
---|
513 | Dim fSumScore As Double |
---|
514 | Dim fSumScoreSquare As Double |
---|
515 | Dim fLeadingCoefficient As Double |
---|
516 | Dim x As Double |
---|
517 | |
---|
518 | fSumScore = 0# |
---|
519 | fSumScoreSquare = 0# |
---|
520 | |
---|
521 | 'get ES Place of each pilot for arrival score |
---|
522 | DoESPlacing rsResults |
---|
523 | |
---|
524 | 'loop over all pilot results |
---|
525 | rsResults.MoveFirst |
---|
526 | |
---|
527 | |
---|
528 | While Not rsResults.EOF |
---|
529 | |
---|
530 | 'prepare for update |
---|
531 | rsResults.Edit |
---|
532 | |
---|
533 | strStatus = rsResults.Fields("resStatus").Value |
---|
534 | |
---|
535 | 'give only score to pilots with LO or GOAL |
---|
536 | If strStatus = "LO" Or strStatus = "GOAL" Then |
---|
537 | |
---|
538 | 'give distance score |
---|
539 | If lTaskDistanceFlag = 1 And m_fTopDistance <> 0# Then |
---|
540 | |
---|
541 | Dim fDistanceScoreLinear As Double |
---|
542 | Dim fDistanceScoreByDifficulty As Double |
---|
543 | |
---|
544 | 'Score by difficulty |
---|
545 | If m_nPilotsGoal = m_nPilotsLaunched Then |
---|
546 | 'GAP FIX September 99: all pilots launched in goal |
---|
547 | fDistanceScoreByDifficulty = 0.5 |
---|
548 | Else |
---|
549 | fDistanceScoreByDifficulty = aDistanceArray(Int(rsResults.Fields("resDistance").Value * 10#)).fScorePercent |
---|
550 | End If |
---|
551 | |
---|
552 | 'Linear score by distance |
---|
553 | fDistanceScoreLinear = rsResults.Fields("resDistance").Value / 2# / m_fTopDistance |
---|
554 | |
---|
555 | 'Add two distance score categories and round |
---|
556 | fScoreDistance = (fDistanceScoreLinear + fDistanceScoreByDifficulty) * m_fAvailableScoreDistance |
---|
557 | fScoreDistance = modTools.RoundValue(fScoreDistance, enumRoundTaskScore) |
---|
558 | rsResults.Fields("resDistanceScore").Value = fScoreDistance |
---|
559 | Else |
---|
560 | fScoreDistance = 0# |
---|
561 | rsResults.Fields("resDistanceScore").Value = 0# |
---|
562 | End If |
---|
563 | |
---|
564 | 'give speed score |
---|
565 | If m_dtmTopTime <> dtmEmptyDate And _ |
---|
566 | Null2EmptyTime(rsResults.Fields("resTime").Value) <> dtmEmptyDate And _ |
---|
567 | lTaskSpeedFlag = 1 And _ |
---|
568 | rsResults.Fields("resReachedES").Value = True And _ |
---|
569 | (Null2EmptyTime(rsTask.Fields("tasESClose").Value) = dtmEmptyDate Or rsResults.Fields("resESTime").Value <= rsTask.Fields("tasESClose").Value) Then |
---|
570 | |
---|
571 | fScoreTime = 1 - (((DecimalTimeFromDate(rsResults.Fields("resTime").Value) - DecimalTimeFromDate(m_dtmTopTime)) / Sqr(DecimalTimeFromDate(m_dtmTopTime))) ^ (2# / 3#)) |
---|
572 | If fScoreTime < 0# Then fScoreTime = 0# |
---|
573 | fScoreTime = fScoreTime * m_fAvailableScoreTime |
---|
574 | |
---|
575 | 'Apply penalty |
---|
576 | If lGoalPenalty = 1 And rsResults.Fields("resStatus").Value <> "GOAL" Then |
---|
577 | fScoreTime = fScoreTime - (fScoreTime * 0.2) |
---|
578 | If fScoreTime < 0 Then fScoreTime = 0 |
---|
579 | End If |
---|
580 | |
---|
581 | fScoreTime = modTools.RoundValue(fScoreTime, enumRoundTaskScore) |
---|
582 | rsResults.Fields("resSpeedScore").Value = fScoreTime |
---|
583 | |
---|
584 | 'give departure score |
---|
585 | If lGAPVersion < 2002 And fNominalTime <> 0# And Null2EmptyTime(rsResults.Fields("resTime").Value) <> dtmEmptyDate And lTaskDepartureFlag = 1 Then |
---|
586 | |
---|
587 | x = (DecimalTimeFromDate(rsResults.Fields("resSSTime").Value) - DecimalTimeFromDate(m_dtmTimeFirstTakeoffWithES)) / fNominalTime |
---|
588 | |
---|
589 | If (lGAPVersion >= 2000 And x >= 1 / 2) Or (lGAPVersion < 2000 And x >= 1 / 3) Then |
---|
590 | fScoreDeparture = 0# |
---|
591 | Else |
---|
592 | If (lGAPVersion < 2000) Then |
---|
593 | fScoreDeparture = 1 - 6.312 * x + 10.932 * x * x - 2.99 * x * x * x |
---|
594 | Else |
---|
595 | fScoreDeparture = 1 - 4.776 * x + 8.309 * x * x - 5.514 * x * x * x |
---|
596 | End If |
---|
597 | If m_fAvailableScoreTime <> 0# And m_fAvailableScoreDeparture <> 0# Then |
---|
598 | fScoreDeparture = fScoreDeparture * fScoreTime / (m_fAvailableScoreTime / m_fAvailableScoreDeparture) |
---|
599 | Else |
---|
600 | fScoreDeparture = 0# |
---|
601 | End If |
---|
602 | fScoreDeparture = modTools.RoundValue(fScoreDeparture, enumRoundTaskScore) |
---|
603 | End If |
---|
604 | |
---|
605 | If fScoreDeparture > m_fAvailableScoreDeparture Then fScoreDeparture = m_fAvailableScoreDeparture |
---|
606 | rsResults.Fields("resDepartureScore").Value = fScoreDeparture |
---|
607 | Else |
---|
608 | fScoreDeparture = 0# |
---|
609 | rsResults.Fields("resDepartureScore").Value = 0# |
---|
610 | End If |
---|
611 | |
---|
612 | 'give arrival score |
---|
613 | If m_nPilotsES <> 0# And Null2EmptyTime(rsResults.Fields("resTime").Value) <> dtmEmptyDate And lTaskArrivalFlag = 1 Then |
---|
614 | x = 1 - ((rsResults.Fields("resPlaceES").Value - 1) / m_nPilotsES) |
---|
615 | fScoreArrival = 0.2 + 0.037 * x + 0.13 * x * x + 0.633 * x * x * x |
---|
616 | fScoreArrival = fScoreArrival * m_fAvailableScoreArrival |
---|
617 | fScoreArrival = modTools.RoundValue(fScoreArrival, enumRoundTaskScore) |
---|
618 | rsResults.Fields("resArrivalScore").Value = fScoreArrival |
---|
619 | Else |
---|
620 | fScoreArrival = 0# |
---|
621 | rsResults.Fields("resArrivalScore").Value = 0# |
---|
622 | End If |
---|
623 | |
---|
624 | Else |
---|
625 | fScoreTime = 0# |
---|
626 | fScoreArrival = 0# |
---|
627 | fScoreDeparture = 0# |
---|
628 | rsResults.Fields("resSpeedScore").Value = 0# |
---|
629 | rsResults.Fields("resDepartureScore").Value = 0# |
---|
630 | rsResults.Fields("resArrivalScore").Value = 0# |
---|
631 | |
---|
632 | End If |
---|
633 | |
---|
634 | 'Give departure score for GAP 2002 |
---|
635 | If lGAPVersion >= 2002 And lTaskDepartureFlag = 1 Then |
---|
636 | If m_bLCFieldIsUsed Then |
---|
637 | fLeadingCoefficient = rsResults.Fields("resLeadingCoeff") |
---|
638 | Else |
---|
639 | If (DecimalTimeFromDate(rsResults.Fields("resESTime").Value) > 0) Then |
---|
640 | fLeadingCoefficient = (DecimalTimeFromDate(rsResults.Fields("resSSTime").Value) + _ |
---|
641 | DecimalTimeFromDate(rsResults.Fields("resESTime").Value) - _ |
---|
642 | 2 * DecimalTimeFromDate(m_dtmTimeFirstTakeoffWithES)) |
---|
643 | Else |
---|
644 | fLeadingCoefficient = 0 |
---|
645 | End If |
---|
646 | End If |
---|
647 | If fLeadingCoefficient > 0 Then |
---|
648 | fScoreDeparture = (fLeadingCoefficient - m_fSmallestLeadingCoefficient) / (m_fSmallestLeadingCoefficient ^ 0.5) |
---|
649 | fScoreDeparture = fScoreDeparture ^ 0.666 |
---|
650 | fScoreDeparture = 1 - fScoreDeparture |
---|
651 | If (fScoreDeparture < 0) Then fScoreDeparture = 0# |
---|
652 | Else |
---|
653 | fScoreDeparture = 0# |
---|
654 | End If |
---|
655 | |
---|
656 | If m_fAvailableScoreTime <> 0# And m_fAvailableScoreDeparture <> 0# Then |
---|
657 | 'fScoreDeparture = fScoreDeparture * fScoreTime / (m_fAvailableScoreTime / m_fAvailableScoreDeparture) |
---|
658 | fScoreDeparture = fScoreDeparture * m_fAvailableScoreDeparture |
---|
659 | Else |
---|
660 | fScoreDeparture = 0# |
---|
661 | End If |
---|
662 | fScoreDeparture = modTools.RoundValue(fScoreDeparture, enumRoundTaskScore) |
---|
663 | |
---|
664 | If fScoreDeparture > m_fAvailableScoreDeparture Then fScoreDeparture = m_fAvailableScoreDeparture |
---|
665 | |
---|
666 | rsResults.Fields("resDepartureScore").Value = fScoreDeparture |
---|
667 | |
---|
668 | Else |
---|
669 | |
---|
670 | End If |
---|
671 | |
---|
672 | fScoreTotal = fScoreDistance + fScoreTime + fScoreDeparture + fScoreArrival |
---|
673 | If fScoreTotal > m_fMaxScoreTotal Then m_fMaxScoreTotal = fScoreTotal |
---|
674 | fScoreTotal = modTools.RoundValue(fScoreTotal, enumRoundTaskScoreTotal) |
---|
675 | rsResults.Fields("resScore").Value = fScoreTotal |
---|
676 | |
---|
677 | fSumScore = fSumScore + fScoreTotal |
---|
678 | fSumScoreSquare = fSumScoreSquare + fScoreTotal ^ 2 |
---|
679 | |
---|
680 | Else |
---|
681 | |
---|
682 | rsResults.Fields("resDistanceScore").Value = 0# |
---|
683 | rsResults.Fields("resSpeedScore").Value = 0# |
---|
684 | rsResults.Fields("resDepartureScore").Value = 0# |
---|
685 | rsResults.Fields("resArrivalScore").Value = 0# |
---|
686 | rsResults.Fields("resScore").Value = 0# |
---|
687 | |
---|
688 | End If |
---|
689 | |
---|
690 | rsResults.Update |
---|
691 | rsResults.MoveNext |
---|
692 | |
---|
693 | Wend |
---|
694 | |
---|
695 | If m_nPilotsLaunched > 1 Then |
---|
696 | m_fTaskWeight = Sqr((m_nPilotsLaunched * fSumScoreSquare - fSumScore ^ 2) / (m_nPilotsLaunched * (m_nPilotsLaunched - 1))) |
---|
697 | End If |
---|
698 | |
---|
699 | End Sub |
---|
700 | |
---|
701 | '-------------------------------------------------------------------------------- |
---|
702 | ' DoESPlacing - |
---|
703 | '-------------------------------------------------------------------------------- |
---|
704 | ' Sorts pilots by place at end of speed section and saves place in results - |
---|
705 | ' recordset. - |
---|
706 | '-------------------------------------------------------------------------------- |
---|
707 | |
---|
708 | Private Sub DoESPlacing(rsResults As DAO.Recordset) |
---|
709 | |
---|
710 | Dim lPlace As Long |
---|
711 | Dim dtmLastTime As Date |
---|
712 | Dim lLastPlace As Long |
---|
713 | Dim rsResultsSortedByESTime As DAO.Recordset |
---|
714 | |
---|
715 | rsResults.Sort = "resESTime ASC" |
---|
716 | Set rsResultsSortedByESTime = rsResults.OpenRecordset |
---|
717 | |
---|
718 | 'init Place counter |
---|
719 | lPlace = 0 |
---|
720 | dtmLastTime = CDate("23:59:59") |
---|
721 | lLastPlace = 1 |
---|
722 | |
---|
723 | While Not rsResultsSortedByESTime.EOF |
---|
724 | |
---|
725 | rsResultsSortedByESTime.Edit |
---|
726 | |
---|
727 | If rsResultsSortedByESTime.Fields("resReachedES").Value = True And Null2EmptyTime(rsResultsSortedByESTime.Fields("resESTime").Value) <> dtmEmptyDate Then |
---|
728 | |
---|
729 | lPlace = lPlace + 1 |
---|
730 | |
---|
731 | 'decide if place is same as before |
---|
732 | If Null2EmptyTime(rsResultsSortedByESTime.Fields("resESTime").Value) = dtmLastTime Then |
---|
733 | 'same place |
---|
734 | rsResultsSortedByESTime.Fields("resPlaceES").Value = lLastPlace |
---|
735 | Else |
---|
736 | rsResultsSortedByESTime.Fields("resPlaceES").Value = lPlace |
---|
737 | dtmLastTime = Null2EmptyTime(rsResultsSortedByESTime.Fields("resESTime").Value) |
---|
738 | lLastPlace = lPlace |
---|
739 | End If |
---|
740 | Else |
---|
741 | rsResultsSortedByESTime.Fields("resPlaceES").Value = 0 |
---|
742 | End If |
---|
743 | |
---|
744 | rsResultsSortedByESTime.Update |
---|
745 | rsResultsSortedByESTime.MoveNext |
---|
746 | |
---|
747 | Wend |
---|
748 | |
---|
749 | rsResultsSortedByESTime.Close |
---|
750 | Set rsResultsSortedByESTime = Nothing |
---|
751 | |
---|
752 | End Sub |
---|
753 | |
---|
754 | '-------------------------------------------------------------------------------- |
---|
755 | ' ResetPreValues - |
---|
756 | '-------------------------------------------------------------------------------- |
---|
757 | ' Init values. - |
---|
758 | '-------------------------------------------------------------------------------- |
---|
759 | |
---|
760 | Private Sub ResetPreValues() |
---|
761 | |
---|
762 | m_nPilotsLaunched = 0 |
---|
763 | m_nPilotsGoal = 0 |
---|
764 | m_nPilotsES = 0 |
---|
765 | m_nPilotsLO = 0 |
---|
766 | m_nPilotsABS = 0 |
---|
767 | m_nPilotsDNF = 0 |
---|
768 | m_nPilotsPresent = 0 |
---|
769 | m_nPilotsMinimumDistance = 0 |
---|
770 | m_nPilotsWithSpeedScore = 0 |
---|
771 | |
---|
772 | 'Tops |
---|
773 | m_fTopSpeed = 0# |
---|
774 | m_fTopDistance = 0# |
---|
775 | m_dtmTopTime = dtmEmptyDate |
---|
776 | m_dtmTimeFirstInES = dtmEmptyDate |
---|
777 | m_dtmTimeFirstTakeoffWithES = dtmEmptyDate |
---|
778 | m_fSumDistance = 0# |
---|
779 | m_fSumDistanceNominal = 0# |
---|
780 | m_fSumDistanceMinimum = 0# |
---|
781 | m_fAverageDistance = 0# |
---|
782 | m_fSmallestLeadingCoefficient = 0# |
---|
783 | m_bLCFieldIsUsed = False |
---|
784 | |
---|
785 | 'Coefficients for day quality |
---|
786 | m_fCDistance = 0# |
---|
787 | m_fCLaunch = 0# |
---|
788 | m_fCTime = 0# |
---|
789 | m_fDayQuality = 0# |
---|
790 | |
---|
791 | 'Score distribution |
---|
792 | m_fDistanceWeight = 0# |
---|
793 | m_fTaskWeight = 0# |
---|
794 | m_fAvailableScoreDistance = 0# |
---|
795 | m_fAvailableScoreTime = 0# |
---|
796 | m_fAvailableScoreDeparture = 0# |
---|
797 | m_fAvailableScoreArrival = 0# |
---|
798 | m_fAvailableScoreTotal = 0# |
---|
799 | |
---|
800 | 'Pilots |
---|
801 | m_strPilotWithTopSpeed = "" |
---|
802 | m_strPilotFirstES = "" |
---|
803 | m_strPilotFirstTakeoffWithES = "" |
---|
804 | |
---|
805 | End Sub |
---|
806 | |
---|
807 | |
---|
808 | |
---|