Racket/TSS

#lang racket

;;;;;;;;;;;
;; Anders Sikvall Sommarhack 2026
;; 2026-07-09 <anders@sikvall.se>
;;
;; Använder "TrainingPeaks" metod för beräkningar av de olika parametrarna
;; baserade på Training Stress Score (TSS) som i sin ur ger de olika
;; måtten enligt:
;;
;; TSS -- Training stress score, belastningsmått för motionsaktiviteter
;; CTL -- Chronic Training Level, TSS utslaget över 6 veckors tid, viktat mot närtid
;; ATL -- Acute Training Level, TSS utslaget över senaste 7 dagarna
;; TSB -- Skillnaden mellan ATL-CTL, negativt betyder förbättring

(require 2htdp/batch-io)
(require racket/date)
(require plot)

;; --- Konstanter och Alfa-värden ---
(define ctl-alpha (/ 2 (+ 42 1)))
(define atl-alpha (/ 2 (+ 7 1)))
(define SECONDS-PER-DAY 86400)

(define (calc-next-ewma current-tss previous-val alpha)
  (+ (* current-tss alpha) (* previous-val (- 1 alpha))))

;; Datumhantering
(define (string->date-seconds raw-str)
  (define clean-str (string-trim raw-str (regexp "[\"'\r\n ]")))
  (match (regexp-match #px"([0-9]{4})-([0-9]{2})-([0-9]{2})" clean-str)
    [(list _ year-str month-str day-str)
     (find-seconds 0 0 12 
                   (string->number day-str)
                   (string->number month-str)
                   (string->number year-str))]
    [_ (error "Felaktigt datumformat, använd YYYY-MM-DD:" raw-str)]))

(define (date-seconds->string secs)
  (define d (seconds->date secs))
  (format "~a-~a-~a"
          (date-year d)
          (if (< (date-month d) 10) (format "0~a" (date-month d)) (date-month d))
          (if (< (date-day d) 10) (format "0~a" (date-day d)) (date-day d))))

;; --- Ackumulering och Utfyllnad ---
(define (fill-and-compute-metrics data-map start-secs end-secs)
  (let loop ([current start-secs]
             [prev-ctl 0.0]
             [prev-atl 0.0]
             [acc '()])
    (if (> current end-secs)
        (reverse acc)
        (let* ([date-str (date-seconds->string current)]
               [tss (hash-ref data-map date-str 0.0)]
               [current-ctl (calc-next-ewma tss prev-ctl ctl-alpha)]
               [current-atl (calc-next-ewma tss prev-atl atl-alpha)]
               [current-tsb (- current-ctl current-atl)])
          (loop (+ current SECONDS-PER-DAY)
                current-ctl
                current-atl
                (cons (list current date-str tss current-ctl current-atl current-tsb) acc))))))

;; --- Plottning (Standardiserad och Stabil) ---
(define (plot-training-data calculated-timeline)
  (define-values (tss-pts ctl-pts atl-pts tsb-pts)
    (for/fold ([tss-acc '()] [ctl-acc '()] [atl-acc '()] [tsb-acc '()])
              ([day calculated-timeline])
      (match-let ([(list secs date tss ctl atl tsb) day])
        (values (cons (list secs tss) tss-acc)
                (cons (list secs ctl) ctl-acc)
                (cons (list secs atl) atl-acc)
                (cons (list secs tsb) tsb-acc)))))

  ;; Använd enbart standardskalor och inbyggda date-ticks som bevisat fungerar
  (parameterize ([plot-x-ticks (date-ticks)]
                 [plot-x-label "Datum"]
                 [plot-y-label "Värde (TSS / CTL / ATL / TSB)"])
    
    (plot (list (lines (reverse tss-pts) #:color "lightgray" #:width 1 #:label "TSS")
                (lines (reverse ctl-pts) #:color "blue" #:width 2 #:label "CTL (Kondition)")
                (lines (reverse atl-pts) #:color "red" #:width 2 #:label "ATL (Trötthet)")
                ;; TSB ritas med långa streck för att sticka ut tydligt på samma skala
                (lines (reverse tsb-pts) #:color "forestgreen" #:width 2 #:style 'long-dash #:label "TSB (Form)"))
          #:title "Träningsbelastning"
          #:legend-anchor 'top-left)))

;; --- Huvudfunktion ---
(define (process-training-data input-file output-file)
  (define raw-lines (read-csv-file input-file))
  
  (define data-lines 
    (filter (lambda (row) 
              (and (not (null? row)) 
                   (regexp-match? #px"[0-9]" (car row))
                   (not (string-prefix? (string-trim (car row)) "Datum"))))
            raw-lines))
  
  (define data-map
    (for/hash ([row data-lines])
      (define clean-date (date-seconds->string (string->date-seconds (car row))))
      (define raw-tss (string->number (string-trim (cadr row) (regexp "[\"'\r\n ]"))))
      (define clean-tss (if raw-tss raw-tss 0.0))
      (values clean-date clean-tss)))
  
  (define sorted-secs 
    (sort (map string->date-seconds (hash-keys data-map)) <))
  
  (when (null? sorted-secs)
    (error "Ingen giltig träningsdata hittades i filen."))
  
  (define start-secs (car sorted-secs))
  (define end-secs (last sorted-secs))
  
  (define calculated-timeline 
    (fill-and-compute-metrics data-map start-secs end-secs))
  
  (define header '("Datum" "TSS" "CTL" "ATL" "TSB"))
  (define output-rows
    (cons header
          (map (lambda (day-data)
                 (match-let ([(list secs date tss ctl atl tsb) day-data])
                   (list date
                         (number->string (exact->inexact tss))
                         (real->decimal-string ctl 1)
                         (real->decimal-string atl 1)
                         (real->decimal-string tsb 1))))
               calculated-timeline)))
  
  (write-file output-file 
              (string-join 
               (map (lambda (row) (string-join row ",")) output-rows)
               "\n"))
  (printf "Klart! Data har fyllts i dag för dag och skrivits till ~a\n" output-file)
  
  (plot-training-data calculated-timeline))

;; --- KÖR PROGRAMMET ---
(process-training-data "training.csv" "training_calculated.csv")