update_predictions.rkt 7.2 KB

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