update_predictions.rkt 6.7 KB

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