Racket/TSS

Från Täpp-Anders
Version från den 9 juli 2026 kl. 15.39 av Anders (diskussion | bidrag) (Skapade sidan med '<pre> #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 uts...')
Hoppa till navigeringHoppa till sök
#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")