Racket/TSS
Från Täpp-Anders
#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 tur 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 -- Acuste 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)
;; --- 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)
;; Rensa bort eventuella citattecken eller dolda tecken
(define clean-str (string-trim raw-str (regexp "[\"'\r\n ]")))
;; Matcha och stycka upp strängen i YYYY MM DD.
(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)]))
;; Gör om sekunder tillbaka till "YYYY-MM-DD"
(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 date-str tss current-ctl current-atl current-tsb) acc))))))
;; --- Huvudfunktion ---
(define (process-training-data input-file output-file)
(define raw-lines (read-csv-file input-file))
;; Filtrera bort rader som är tomma eller inte innehåller siffror i första kolumnen
(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))
;; Bygg en Hash-map för snabb uppslagning av Datum -> TSS
(define data-map
(for/hash ([row data-lines])
(define clean-date (date-seconds->string (string->date-seconds (car row))))
(define clean-tss (string->number (string-trim (cadr row) (regexp "[\"'\r\n ]"))))
(values clean-date clean-tss)))
;; Sortera alla unika datum för att hitta start och slut
(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))
;; Beräkna kompletta metrics dag för dag
(define calculated-timeline
(fill-and-compute-metrics data-map start-secs end-secs))
;; Formatera för export
(define header '("Datum" "TSS" "CTL" "ATL" "TSB"))
(define output-rows
(cons header
(map (lambda (day-data)
(match-let ([(list 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)))
;; Skriv till CSV-fil
(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))
;; --- KÖR PROGRAMMET ---
(process-training-data "training.csv" "training_calculated.csv")