Racket/TSS: Skillnad mellan sidversioner
Från Täpp-Anders
Hoppa till navigeringHoppa till sök
Skapade sidan med 'It absolutely was months considering that he had the courage ought to any appealing girl from a date. [http://www.binaryoptionsystem.us binary options trader] You will find ...' |
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...' |
||
| Rad 1: | Rad 1: | ||
<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 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") | |||
</pre> | |||
Versionen från 9 juli 2026 kl. 15.39
#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")