1
0

update_predictions.rkt 7.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181
  1. #lang racket/base
  2. ; Add new predictions, update predictions, add outcomes
  3. (require racket/cmdline
  4. racket/date
  5. racket/list
  6. db)
  7. (require "scoring_rules.rkt")
  8. (define progname "update_predictions.rkt")
  9. ; load configuration file
  10. (require (file "../config.rkt"))
  11. ; give us the date in YYYY-MM-DD format
  12. (date-display-format 'iso-8601)
  13. (define (pending)
  14. (write-string "Functionality not yet implemented.\n"))
  15. ; set up command line arguments
  16. (define mode (command-line
  17. #:program "update_prediction"
  18. #:args ([updatetype "help"]) ; (add, update, outcome help)
  19. updatetype))
  20. ; check a date, if blank return current date
  21. (define (verify-or-get-date datestr)
  22. (if (regexp-match-exact? #px"\\d{4}-\\d{2}-\\d{2}" datestr)
  23. datestr
  24. (date->string (current-date))))
  25. ; print some help
  26. (define (printhelp)
  27. (write-string (string-append "Usage: "
  28. progname " MODE\n\n"))
  29. (write-string "Where MODE is one of:\n")
  30. (write-string " add\t\t - add new prediction to database.\n")
  31. (write-string " update\t\t - update a prediction with results.\n")
  32. (write-string " list-open\t - Show all predictions that do not yet have outcomes.\n")
  33. (write-string " list-closed\t - Show all predictions that have outcomes.\n")
  34. (write-string " score\t\t - Calculate and display Brier scores for predictions with logged outcomes.\n")
  35. (write-string " help\t\t - Show this help message.\n")
  36. (write-string "\nCopyright 2019 George C. Privon\n"))
  37. ; set up a condensed prompt for getting information
  38. (define (getinput prompt)
  39. (write-string prompt)
  40. (write-string ": ")
  41. (read-line))
  42. ; add a new prediction
  43. (define (addpred)
  44. ; manually get incremented ID
  45. (define lastID (query-maybe-value conn "SELECT ID FROM predictions ORDER BY ID DESC LIMIT 1"))
  46. (define nID
  47. (if lastID
  48. (+ 1 lastID)
  49. (+ 1 0)))
  50. (define prediction (getinput "Enter the prediction"))
  51. (define fprob (getinput "Enter your forecast probability"))
  52. (define comments (getinput "Comments on the forecast"))
  53. (define categories (getinput "Enter any categories (comma-separated)"))
  54. (define date (getinput "Enter the date of the forecast (YYYY-MM-DD or leave blank to use today's date)"))
  55. (define enterdate (verify-or-get-date date))
  56. (query-exec conn "INSERT INTO predictions (ID, date, prediction, forecast, comments, categories) values (?,?, ?, ?, ?, ?)"
  57. nID enterdate prediction fprob comments categories))
  58. ; print a prediction given an ID
  59. (define (printpred ID)
  60. ; write most recent forecast information
  61. (write-string ((λ (myID)
  62. (define prediction (query-value conn "SELECT prediction FROM predictions WHERE ID=? ORDER BY date ASC LIMIT 1" myID))
  63. (define lastf (query-row conn "SELECT date, forecast FROM predictions WHERE ID=? AND forecast IS NOT NULL ORDER BY date DESC LIMIT 1" myID))
  64. (string-append (number->string myID)
  65. "("
  66. (vector-ref lastf 0)
  67. ") "
  68. prediction
  69. ": "
  70. (number->string (vector-ref lastf 1))))
  71. ID))
  72. (write-string "\n"))
  73. ; update a prediction
  74. (define (updatepred ID)
  75. (define option (string->number (getinput "Enter \"1\" to add an updated prediction or \"2\" to enter an outcome")))
  76. (cond
  77. [(eq? option 1) (reviseprediction ID)]
  78. [(eq? option 2) (addoutcome ID)]))
  79. ; add a new forecast to an existing prediction
  80. (define (reviseprediction ID)
  81. (define newf (string->number (getinput "What is your new predction")))
  82. (define date (getinput "Enter the date of the outcome (YYYY-MM-DD or leave blank to use today's date)"))
  83. (define newfdate (verify-or-get-date date))
  84. (define comments (getinput "Comments on the new prediction"))
  85. (query-exec conn "INSERT INTO predictions (ID, date, forecast, comments) values (?, ?, ?, ?)"
  86. ID newfdate newf comments))
  87. ; enter an outcome
  88. (define (addoutcome ID)
  89. (define lastpred (query-value conn "SELECT forecast FROM predictions WHERE ID=? ORDER BY date DESC LIMIT 1" ID))
  90. (define outcome (string->number (getinput "What is the outcome (0 for didn't happen, 1 for happened)")))
  91. (define date (getinput "Enter the date of the outcome (YYYY-MM-DD or leave blank to use today's date)"))
  92. (define outcomedate (verify-or-get-date date))
  93. (define comments (getinput "Comments on the outcome"))
  94. (cond
  95. [(not (or (eq? outcome 0) (eq? outcome 1))) (error "Outcome must be 0 or 1.\n")])
  96. (query-exec conn "INSERT INTO predictions (ID, date, outcome, comments) values (?, ?, ?, ?)"
  97. ID outcomedate outcome comments)
  98. (define bscore (brier-score lastpred outcome))
  99. (write-string (string-append "Brier score of most recent forecast: "
  100. (number->string bscore)
  101. "\n.")))
  102. ; print open predictions
  103. (define (printopen)
  104. ; get a list of all IDs
  105. (define allIDs (query-list conn
  106. "SELECT DISTINCT ID FROM predictions"))
  107. ; get list of resolved predictions
  108. (define resIDs (query-list conn
  109. "SELECT DISTINCT ID FROM predictions WHERE outcome IS NOT NULL"))
  110. ; remove out the IDs that are resolved, keeping only the open predictions
  111. (define uIDs (filter-map (λ (testID)
  112. (if (member testID resIDs) #f testID))
  113. allIDs))
  114. ; print a header and individual entry information
  115. (write-string "ID(DATE) PREDICTION: LATEST FORECAST\n")
  116. (map printpred uIDs))
  117. ; print resolved predictions
  118. (define (printres)
  119. (define uIDs (query-list conn
  120. "SELECT DISTINCT ID FROM predictions WHERE outcome IS NOT NULL"))
  121. (write-string "ID(DATE) PREDICTION: LAST FORECAST, OUTCOME, BRIER SCORE\n")
  122. (map printpred uIDs))
  123. ; find unresolved predictions
  124. (define (findpending)
  125. (printopen)
  126. (define upID (getinput "Please enter a prediction number to edit (enter 0 or nothing to exit)"))
  127. (cond
  128. [(eq? (string->number upID) 0) (exit)]
  129. [(string->number upID) (updatepred (string->number upID))]
  130. [else (exit)]))
  131. ; compute Brier score for all predictions with outcomes
  132. (define (score)
  133. (define uIDs (query-list conn
  134. "SELECT DISTINCT ID FROM predictions WHERE outcome IS NOT NULL"))
  135. ; mapping across uIDs:
  136. ; - get list of all forecasts for this prediction
  137. ; - compute Brier score for all forecasts (relative to outcome)
  138. ; - write out
  139. (pending)
  140. )
  141. ; make sure we can use the sqlite3 connection
  142. (cond (not (sqlite3-available?))
  143. (error "Sqlite3 library not available."))
  144. ; open the database file
  145. (define conn (sqlite3-connect #:database dbloc))
  146. ; determine which mode we're in
  147. (cond
  148. [(regexp-match "help" mode) (printhelp)]
  149. [(regexp-match "add" mode) (addpred)]
  150. [(regexp-match "update" mode) (findpending)]
  151. [(regexp-match "list-open" mode) (printopen)]
  152. [(regexp-match "list-closed" mode) (printres)]
  153. [(regexp-match "score" mode) (score)]
  154. [else (error(string-append "Unknown mode. Try " progname " help\n\n"))])
  155. ; close the databse
  156. (disconnect conn)