Täpp-Anders - Senaste ändringarna [sv]

Racket/RLE

Anders — Sat, 11 Apr 2026 14:45:36 GMT

@@ Rad 20: / Rad 20: @@
 ;; --help visar en enkel hjälptext
 ;; --test kör en enkel sån därn JOONIT TÄST di kallart
 ;;;;;

Racket/RLE

Anders — Sat, 11 Apr 2026 14:38:41 GMT

Skapade sidan med '<pre> #lang racket ;;;;; ;; RLE – Run Length Encoder ;; ;; I/O via stdio <infil >utfil ;; ;; Kodar data genom att räkna antal förekomster av samma tecken/byte i rad och ;; ersätter den med ett cons-par (antal . tecken) tills nästa förekomst finns. ;; Kan operera binärt men med begränsningen av max 255 bytes konsekutivt sedan ;; startas en ny ram. ;; ;; racket rle.rkt [ --encode | --decode | --help ] [ --binary ] < infil > utfil ;; ;; --encode kodar stdin till...'

Ny sida

<pre>

#lang racket

;;;;;
;; RLE – Run Length Encoder
;;
;; I/O via stdio <infil >utfil
;;
;; Kodar data genom att räkna antal förekomster av samma tecken/byte i rad och
;; ersätter den med ett cons-par (antal . tecken) tills nästa förekomst finns.
;; Kan operera binärt men med begränsningen av max 255 bytes konsekutivt sedan
;; startas en ny ram.
;;
;; racket rle.rkt [ --encode | --decode | --help ] [ --binary ] < infil > utfil
;;
;; --encode kodar stdin till stdout lisp style om inte --binary används
;; --decode avkodar stdin till stdout lisp style om inte --binary används
;; --binary skriver kodad data binärt, läser binär data för avkodning
;; --help visar en enkel hjälptext
;; --test kör en enkel sån därn JOONIT TÄST di kallart
;;;;;

;; --- Kärnlogik ---

;; Grupperar element
(define (pack-limited lst)
(cond [(empty? lst) '()]
[else
(let-values ([(prefix suffix) (splitf-at lst (lambda (x) (equal? x (first lst))))])
(if (> (length prefix) 255)
;; Om gruppen är för lång, hugg av vid 255 och fortsätt med resten
(cons (take prefix 255) (pack-limited (append (drop prefix 255) suffix)))
;; Annars, fortsätt som vanligt
(cons prefix (pack-limited suffix))))]))

(define (encode lst)
(map (lambda (group) (list (length group) (first group)))
(pack-limited lst)))

(define (decode lst)
(append-map (lambda (entry) (make-list (first entry) (second entry)))
lst))

;; --- Binär I/O ---

(define (write-binary encoded-data)
(for ([pair encoded-data])
(write-byte (first pair))
(write-byte (second pair))))

(define (read-binary)
(let ([count (read-byte)])
(if (eof-object? count)
'()
(let ([val (read-byte)])
(cons (list count val) (read-binary))))))

;; --- Körlägen ---

(define (run-encode binary?)
(let* ([input (port->bytes (current-input-port))]
[encoded (encode (bytes->list input))])
(if binary?
(write-binary encoded)
(write encoded)))) ; Använd write för att få korrekt läsbar listformat

(define (run-decode binary?)
(let* ([data (if binary? (read-binary) (read))]
[decoded (decode data)])
(display (list->bytes decoded))))

(define (run-test)
(let* ([input (port->bytes (current-input-port))]
[encoded (encode (bytes->list input))]
[decoded (list->bytes (decode encoded))])
(if (equal? input decoded)
(printf "Test lyckades! (~a bytes in, ~a noder skapade)\n"
(bytes-length input) (length encoded))
(error "Test misslyckades: Datat korrupt!"))))

;; --- CLI ---

(define (show-help)
(displayln "Användning: racket rle.rkt [FLAGGA] < infil > utfil")
(displayln " -e, --encode Koda (standard: text-listor)")
(displayln " -d, --decode Dekoda (standard: text-listor)")
(displayln " -b, --binary Kör i binärläge (1 byte antal, 1 byte värde)")
(displayln " -t, --test Verifiera att koda+dekoda bevarar data")
(displayln " -h, --help Visa denna hjälp"))

(define (main)
(let ([args (vector->list (current-command-line-arguments))])
(cond
[(member "-t" args) (run-test)]
[(and (member "-e" args) (or (member "-b" args) (member "--binary" args))) (run-encode #t)]
[(member "-e" args) (run-encode #f)]
[(and (member "-d" args) (or (member "-b" args) (member "--binary" args))) (run-decode #t)]
[(member "-d" args) (run-decode #f)]
[else (show-help)])))

(main)

</pre>

Racket

Anders — Sat, 11 Apr 2026 14:34:37 GMT

Kodexempel (Sommarhack 2026)

← Äldre version		Versionen från 11 april 2026 kl. 14.34
Rad 17:		Rad 17:
	# [[Racket/base24]]		# [[Racket/base24]]
	# [[Racket/Personreg]]		# [[Racket/Personreg]]
			# [[Racket/RLE]]
	# [[Racket/Lille-GUI]]		# [[Racket/Lille-GUI]]
	# [[Racket/Multitråd]]		# [[Racket/Multitråd]]

Emacs

Anders — Fri, 10 Apr 2026 08:41:25 GMT

.emacs

← Äldre version		Versionen från 10 april 2026 kl. 08.41
Rad 20:		Rad 20:

	(custom-set-faces) ;; Enable wanted face		(custom-set-faces) ;; Enable wanted face

			;; Allow tex input for Unicode characters
			(set-input-method "TeX")

	</pre>		</pre>

Racket/3D-boll

Anders — Tue, 07 Apr 2026 18:18:11 GMT

@@ Rad 1: / Rad 1: @@
 <pre>
 #lang racket
 (require plot)
@@ Rad 70: / Rad 71: @@
 (generate-dots particles)
 (plot3d (points3d particles))
 </pre>

Racket/3D-boll

Anders — Tue, 07 Apr 2026 17:59:56 GMT

Skapade sidan med '<pre> #lang racket (require plot) (require racket/pretty) ;; En pixelboll iracket ;; Från Buzzern skrivet under påskhelgen (define π (acos -1)) (define VERTICAL-SPLIT 16) (define HORIZONTAL-SPLIT 16) (define PARTICLE-SIZE (* VERTICAL-SPLIT HORIZONTAL-SPLIT)) (define particles (for/vector ([i (in-range PARTICLE-SIZE)]) (make-vector 3))) ;; from scheme.com since normal scheme lacks for/vector (define make-matrix (lambda (rows columns) (do ((...'

Ny sida

<pre>

#lang racket
(require plot)
(require racket/pretty)
;; En pixelboll iracket
;; Från Buzzern skrivet under påskhelgen

(define π (acos -1))
(define VERTICAL-SPLIT 16)
(define HORIZONTAL-SPLIT 16)
(define PARTICLE-SIZE (* VERTICAL-SPLIT HORIZONTAL-SPLIT))
(define particles (for/vector ([i (in-range PARTICLE-SIZE)])
(make-vector 3)))

;; from scheme.com since normal scheme lacks for/vector
(define make-matrix
(lambda (rows columns)
(do ((m (make-vector rows))
(i 0 (+ i 1)))
((= i rows) m)
(vector-set! m i (make-vector columns)))))

(define (to->deg rad)
(* rad (/ 180 π)))

(define (print-dots amount)
(let myloop ((count 0))
(if (>= count amount)
'()
(begin
(println count)
(myloop (+ count 1))))))

(define (generate-xyz radius θ ϕ)
(let* ([x (* radius (sin θ) (cos ϕ))]
[y (* radius (sin θ) (sin ϕ))]
[z (* radius (cos θ))]
)
(vector x y z)))

(define (test-loop amount)
(let loop ((count 0))
(if (>= count amount)
'()
(begin
(println count)
(loop (+ count 1))))))

(define (get-angle index split)
(* 2 π index (/ split)))

(define (generate-dots particles)
(let* ([index-y -1])
(for ([row (in-vector particles)]
[index (in-naturals)])
(set! index-y (if (= 0 (modulo index HORIZONTAL-SPLIT))
(+ index-y 1)
index-y))
;(printf " ~a ~a\n" (modulo index HORIZONTAL-SPLIT) index-y)
(define new-θ (get-angle (modulo index HORIZONTAL-SPLIT) HORIZONTAL-SPLIT))
(define new-ϕ (get-angle (modulo index-y VERTICAL-SPLIT) VERTICAL-SPLIT))
(printf " ~a ~a \n" (to->deg new-θ) (to->deg new-ϕ))
;;(vector-set! row 0 )
(vector-set! particles index (generate-xyz 1.0 new-θ new-ϕ)))))

;;(test-loop HORIZONTAL-SPLIT)
;;(generate-xyz 1 π (* 2.0 π))
(generate-dots particles)
(plot3d (points3d particles))

</pre>

Racket

Anders — Tue, 07 Apr 2026 17:57:49 GMT

Kodexempel (Sommarhack 2026)

← Äldre version		Versionen från 7 april 2026 kl. 17.57
Rad 24:		Rad 24:
	# [[Racket/Neural]]		# [[Racket/Neural]]
	# [[Racket/Posits]]		# [[Racket/Posits]]
			# [[Racket/3D-boll]] -- från Olme

Racket/Markov

Anders — Tue, 07 Apr 2026 17:24:36 GMT

@@ Rad 1: / Rad 1: @@
 <pre>
 #lang racket
@@ Rad 87: / Rad 176: @@
                [start-prefix (list-ref all-prefixes (random (length all-prefixes)))])
           (displayln "=== Genererad text med 3:e ordningens Markovkedja (200 ord) ===")
-          (displayln (generate-text-3 model start-prefix 200)))])))
+          (displayln (generate-text-3 model start-prefix 150)))])))
 (main)
 </pre>

Racket/Markov

Anders — Tue, 07 Apr 2026 14:16:08 GMT

Skapade sidan med '<pre> #lang racket ;;;;; ;; Markovkedja av tredje ordningen ;; ;; Tar en textfil eller stdin och bygger statistik över orden i tre gram ;; därefter producerar den en 150 ord lång text baserad på den statistiken ;; ;; Täpp-Anders Sikvall, anders@sikvall.se, 2026-04-07 ;;;;; (require racket/string racket/port) ;; ================================================ ;; MARKOVKEDJA – TREDJE ORDNINGEN (3-gram) ;; ===============================================...'

Ny sida

<pre>
#lang racket

;;;;;
;; Markovkedja av tredje ordningen
;;
;; Tar en textfil eller stdin och bygger statistik över orden i tre gram
;; därefter producerar den en 150 ord lång text baserad på den statistiken
;;
;; Täpp-Anders Sikvall, anders@sikvall.se, 2026-04-07
;;;;;

(require racket/string
racket/port)

;; ================================================
;; MARKOVKEDJA – TREDJE ORDNINGEN (3-gram)
;; ================================================

;; Skapar alla n-gram
(define (make-ngrams words n)
(for/list ([i (in-range 0 (- (length words) (sub1 n)))])
(take (drop words i) n)))

;; Bygger 3:e ordningens Markovmodell – korrekt indexering
(define (build-markov-3 text)
(define words (filter non-empty-string? (string-split text)))
(when (< (length words) 4)
(error 'build-markov-3 "Texten är för kort för 3-gram (minst 4 ord behövs)."))

(define transitions (make-hash))

(for ([i (in-range 0 (- (length words) 3))])
(let* ([prefix (list (list-ref words i)
(list-ref words (+ i 1))
(list-ref words (+ i 2)))]
[next-word (list-ref words (+ i 3))]
[freq-hash (hash-ref! transitions prefix (λ () (make-hash)))])
(hash-update! freq-hash next-word add1 0)))

transitions)

;; Viktad slumpmässig val
(define (weighted-random freq-hash)
(define options (hash->list freq-hash))
(define total (apply + (map cdr options)))
(if (zero? total)
#f
(let ([r (random total)])
(let loop ([lst options] [acc 0])
(match lst
['() #f]
[(cons (cons word count) rest)
(if (< r (+ acc count))
word
(loop rest (+ acc count)))])))))

;; Genererar text
(define (generate-text-3 transitions start-prefix num-words)
(let loop ([current-prefix start-prefix]
[result (vector->list (list->vector start-prefix))] ; enklare append
[remaining (- num-words 3)])
(if (<= remaining 0)
(string-join result " ")
(let* ([freq-hash (hash-ref transitions current-prefix (make-hash))]
[next-word (weighted-random freq-hash)])
(if (not next-word)
(string-join result " ")
(let ([new-prefix (append (cdr current-prefix) (list next-word))])
(loop new-prefix
(append result (list next-word))
(sub1 remaining))))))))

;; ================================================
;; HUVUDPROGRAM
;; ================================================

(define (main)
(let* ([input-text (port->string (current-input-port))]
[words (filter non-empty-string? (string-split input-text))])
(cond
[(< (length words) 4)
(displayln "Fel: Texten är för kort för 3:e ordningens Markovkedja (minst 4 ord behövs).")]
[else
(let* ([model (build-markov-3 input-text)]
[all-prefixes (hash-keys model)]
[start-prefix (list-ref all-prefixes (random (length all-prefixes)))])
(displayln "=== Genererad text med 3:e ordningens Markovkedja (200 ord) ===")
(displayln (generate-text-3 model start-prefix 200)))])))

(main)
</pre>

Racket

Anders — Tue, 07 Apr 2026 14:07:26 GMT

Kodexempel (Sommarhack 2026)

← Äldre version		Versionen från 7 april 2026 kl. 14.07
Rad 21:		Rad 21:
	# [[Racket/6502-emu]]		# [[Racket/6502-emu]]
	# [[Racket/Genetic]]		# [[Racket/Genetic]]
			# [[Racket/Markov]]
	# [[Racket/Neural]]		# [[Racket/Neural]]
	# [[Racket/Posits]]		# [[Racket/Posits]]

Racket/base24

Anders — Tue, 07 Apr 2026 13:05:04 GMT

← Äldre version		Versionen från 7 april 2026 kl. 13.05
Rad 4:		Rad 4:
	;;;;;		;;;;;
	;; BASE24 encoder/decoder		;; BASE24 encoder/decoder
	;; Täpp-Anders Sikvall, anders@sikvall.se, 2026-04-97		;; Täpp-Anders Sikvall, anders@sikvall.se, 2026-04-07
	;;		;;
	;; USAGE		;; USAGE

Racket/base24

Anders — Tue, 07 Apr 2026 13:04:43 GMT

Skapade sidan med '<pre> #lang racket ;;;;; ;; BASE24 encoder/decoder ;; Täpp-Anders Sikvall, anders@sikvall.se, 2026-04-97 ;; ;; USAGE ;; racket base24.rkt --encode < INPUT_FILE > OUTPUT_FILE ;; racket base24.rkt --decode < INPUT_FILE > OUTPUT_FILE ;; ;; COMMENT ;; This does not precede the coded data with any kind of header ;; and the error control and handling is abysmally minimal but ;; it shows the ease of implementing something like this...'

Ny sida

<pre>
#lang racket

;;;;;
;; BASE24 encoder/decoder
;; Täpp-Anders Sikvall, anders@sikvall.se, 2026-04-97
;;
;; USAGE
;; racket base24.rkt --encode < INPUT_FILE > OUTPUT_FILE
;; racket base24.rkt --decode < INPUT_FILE > OUTPUT_FILE
;;
;; COMMENT
;; This does not precede the coded data with any kind of header
;; and the error control and handling is abysmally minimal but
;; it shows the ease of implementing something like this compared
;; to languages like C.
;;
;; EXPLANATION
;; The program treats the entire input as a bignum and then basically
;; converts it to the output by repeated division and looking up the
;; quotient in the BASE24 alphabet. Since the bignum implementation
;; is so efficient in Racket/Scheme this means it will be effective
;; even for moderately large files.
;;
;;

;; BASE24 Alfabet (exkluderar förväxlingsbara tecken)
(define alphabet "BCDFGHJKMPQRTVWXY2346789")
(define base 24)
(define max-col 68)

;; Skapar en map för snabb uppslagning vid avkodning
(define char-to-val
(for/hash ([c (in-string alphabet)]
[i (in-naturals)])
(values c i)))

;; Hjälpfunktion för att skriva ut med radbrytningar
(define (display-with-breaks str)
(let loop ([remaining str])
(cond
[(<= (string-length remaining) max-col)
(displayln remaining)]
[else
(displayln (substring remaining 0 max-col))
(loop (substring remaining max-col))])))

;; --- ENCODER ---
(define (encode)
(let* ([input-bytes (port->bytes (current-input-port))]
[num (bytes->integer input-bytes)])
(if (zero? num)
(displayln (string-ref alphabet 0))
(let loop ([n num] [res '()])
(if (zero? n)
(display-with-breaks (list->string res))
(loop (quotient n base)
(cons (string-ref alphabet (remainder n base)) res)))))))

;; --- DECODER ---
(define (decode)
;; Vi rensar bort eventuella radbrytningar/whitespaces innan vi avkodar
(let* ([raw-input (port->string (current-input-port))]
[input-str (regexp-replace* #px"\\s+" raw-input "")]
[num (for/fold ([n 0])
([char (in-string input-str)])
(+ (* n base) (hash-ref char-to-val char)))])
(display (integer->bytes num))))

;; --- KONVERTERINGSFUNKTIONER ---
(define (bytes->integer b)
(for/fold ([n 0])
([byte (in-bytes b)])
(+ (arithmetic-shift n 8) byte)))

(define (integer->bytes n)
(if (zero? n)
(bytes 0)
(let loop ([i n] [res '()])
(if (zero? i)
(list->bytes res)
(loop (arithmetic-shift i -8)
(cons (bitwise-and i #xFF) res))))))

;; --- CLI HANTERING ---
(define (main)
(match (current-command-line-arguments)
[(vector (or "--encode" "-e")) (encode)]
[(vector (or "--decode" "-d")) (decode)]
[_ (displayln "Användning: racket base24.rkt [--encode | --decode]")]))

(main)
</pre>

Racket

Anders — Tue, 07 Apr 2026 13:04:29 GMT

Kodexempel (Sommarhack 2026)

← Äldre version		Versionen från 7 april 2026 kl. 13.04
Rad 15:		Rad 15:
	# [[Racket/Erastothenes]]		# [[Racket/Erastothenes]]
	# [[Racket/Hexdump]]		# [[Racket/Hexdump]]
			# [[Racket/base24]]
	# [[Racket/Personreg]]		# [[Racket/Personreg]]
	# [[Racket/Lille-GUI]]		# [[Racket/Lille-GUI]]

Huvudsida

Anders — Mon, 06 Apr 2026 16:51:18 GMT

Särskilt utvalda sidor

← Äldre version		Versionen från 6 april 2026 kl. 16.51
Rad 24:		Rad 24:
	* [[Fisher-Yates Shuffle]]		* [[Fisher-Yates Shuffle]]
	* [[Base64]] [[Base32]] [[Base24]]		* [[Base64]] [[Base32]] [[Base24]]
			* [[Racket]]

	== Elektronik ==		== Elektronik ==

Racket/Erastothenes

Anders — Sun, 05 Apr 2026 14:17:31 GMT

@@ Rad 7: / Rad 7: @@
 ;;;;;
 (define (primes-between start stop)
-   (cond
+   (if (> start stop)
-    [(> start stop) '()]
+      '() ;Returnerar tomt om start > stop
-    [else
+      (let ([is-prime? (make-sieve stop)])
-     ; Skapa en bool-vektor för intervallet [0..stop]
+        (for/list ([n (in-range (max start 2) (add1 stop))]
-     (define sieve (make-vector (+ stop 1) #t))
+                   #:when (vector-ref is-prime? n))
+          n))))
-     ; 0 och 1 är inte primtal
-     (vector-set! sieve 0 #f)
-     (vector-set! sieve 1 #f)
+;; Testkörning
+(primes-between 10 50)
 </pre>

Racket/Posits

Anders — Sun, 05 Apr 2026 13:01:42 GMT

Skapade sidan med '<pre> #lang racket ;;;;; ;; En enkel implementation av Posists eller Unum typ III ;; i Racket för skojs skull och för att lära sig mer ;; ;; Täpp-Anders Sikvall anders@sikvall.se 2026-04-04 ;; ;; Posit representeras som ett heltal (bitmönster, 0 till 2^n-1). ;; Parametrar: n = totalt antal bits, es = antal exponent-bits (t.ex. n=16, es=1 för posit16). ;; Innehåller: ;; * Konvertering till/från generiska tal (number->posit och posit->number) ;; * Addition, subt...'

Ny sida

<pre>
#lang racket

;;;;;
;; En enkel implementation av Posists eller Unum typ III
;; i Racket för skojs skull och för att lära sig mer
;;
;; Täpp-Anders Sikvall anders@sikvall.se 2026-04-04
;;
;; Posit representeras som ett heltal (bitmönster, 0 till 2^n-1).
;; Parametrar: n = totalt antal bits, es = antal exponent-bits (t.ex. n=16, es=1 för posit16).
;; Innehåller:
;; * Konvertering till/från generiska tal (number->posit och posit->number)
;; * Addition, subtraktion, multiplikation och division av posits
;;
;; Aritmetiken är implementerad via konvertering till reellt tal + operation + tillbaka till posit
;; (enkel approach som bevarar tapered precision via rounding vid varje steg).
;; Full bit-exakt aritmetik (alignera regime/exponent etc.) är mer komplex och lämnas som utökning.
;; Algoritmen för number->posit är översatt direkt från Gustafsons x2p i "Posits4.pdf".
;; posit->number använder full fält-extraktion (regime, exponent, fraction).

(define (number->posit x n es)
;; x2p-algoritmen från Gustafson (översatt till Racket)
;; Returnerar posit-bitmönster som heltal.
(cond
[(= x 0) 0]
[(infinite? x) (arithmetic-shift 1 (- n 1))]
[else
(let* ([nbits n]
[npat (expt 2 nbits)]
[useed (expt 2 (expt 2 es))]
[y (abs x)]
[p 0]
[i 0]
[e-val (- (expt 2 es) 1)])
;; Northeast/southeast quadrant (regime-byggnad)
(if (>= y 1)
(begin
(set! p 1)
(set! i 2)
(let loop-regime ()
(when (and (>= y useed) (< i nbits))
(set! p (+ (* 2 p) 1))
(set! y (/ y useed))
(set! i (add1 i))
(loop-regime)))
(set! p (* 2 p))
(set! i (add1 i)))
(begin
(set! p 0)
(set! i 1)
(let loop-regime ()
(when (and (< y 1) (<= i nbits))
(set! y (* y useed))
(set! i (add1 i))
(loop-regime)))
(if (>= i nbits)
(begin
(set! p 2)
(set! i (add1 nbits)))
(begin
(set! p 1)
(set! i (add1 i))))))
;; Exponent-extraktion
(let loop-exp ()
(when (and (> e-val 0.5) (<= i nbits))
(set! p (* 2 p))
(when (>= y (expt 2 e-val))
(set! y (/ y (expt 2 e-val)))
(set! p (add1 p)))
(set! e-val (/ e-val 2))
(set! i (add1 i))
(loop-exp)))
(set! y (- y 1))
;; Fraction-bits
(let loop-frac ()
(when (and (> y 0) (<= i nbits))
(set! y (* 2 y))
(set! p (+ (* 2 p) (floor y)))
(set! y (- y (floor y)))
(set! i (add1 i))
(loop-frac)))
;; Skift och rounding (nearest, tie to even)
(set! p (* p (expt 2 (- (+ nbits 1) i))))
(set! i (add1 i))
(let* ([round-bit (bitwise-and p 1)])
(set! p (floor (/ p 2)))
(set! p (cond
[(= round-bit 0) p]
[(= y 0) (+ p (bitwise-and p 1))] ;; tie to even
[else (add1 p)])))
;; Negativt tal: 2's complement (npat - p)
(set! p (modulo (if (< x 0) (- npat p) p) npat))
p)]))

(define (posit->number p n es)
;; Full decode enligt Gustafson/Unum Type III
;; Returnerar exakt reellt tal (flonum för enkelhet, men kan utökas till rational).
(cond
[(= p 0) 0]
[(= p (arithmetic-shift 1 (- n 1))) +inf.0] ;; NaR / ∞
[else
(let* ([sign (if (zero? (bitwise-and p (arithmetic-shift 1 (- n 1)))) 1 -1)]
[abs-p (if (= sign 1)
p
(bitwise-and (+ (bitwise-not p) 1) (- (expt 2 n) 1)))]
[useed (expt 2 (expt 2 es))])
;; Extrahera regime (runlength m av identiska bits)
(let*-values ([(r m) (let ([first-r (bitwise-and (arithmetic-shift abs-p (- (- n 2))) 1)])
(let loop ([pos (- n 2)]
[m 0])
(if (or (< pos -1) (> m n))
(values first-r m)
(let ([bit (bitwise-and (arithmetic-shift abs-p (- pos)) 1)])
(if (= bit first-r)
(loop (sub1 pos) (add1 m))
(values first-r m))))))])
(let* ([k (if (= r 0) (- m) (- m 1))]
;; Regime-field tar m + 1 bits (run + terminator)
[regime-bits-used (+ m 1)]
[exp-start-pos (- (- n 2) regime-bits-used)] ;; första exp-bit (MSB)
;; Ta upp till es exp-bits (pad low bits med 0 om färre)
[exp-bits (if (< exp-start-pos 0)
0
(let loop ([pos exp-start-pos]
[bits-left es]
[e-acc 0])
(if (or (<= bits-left 0) (< pos -1))
e-acc
(let ([bit (bitwise-and (arithmetic-shift abs-p (- pos)) 1)])
(loop (sub1 pos)
(sub1 bits-left)
(+ (* e-acc 2) bit))))))]
[exp-used (min es (max 0 (+ (- n 1) exp-start-pos)))] ;; tillgängliga bits
[f-start-pos (- exp-start-pos exp-used)]
;; Fraction (remaining bits, hidden 1.)
[f (if (< f-start-pos 0)
0
(let loop ([pos f-start-pos]
[f-acc 0]
[fsize 0])
(if (< pos -1)
f-acc
(let ([bit (bitwise-and (arithmetic-shift abs-p (- pos)) 1)])
(loop (sub1 pos)
(+ (* f-acc 2) bit)
(add1 fsize))))))]
[fsize (max 0 (- n 1 regime-bits-used exp-used))] ;; antal fraction-bits
[significand (+ 1 (/ f (expt 2 fsize)))])
(* sign (expt useed k) (expt 2 exp-bits) significand))))]))

;; Aritmetik (enkel via realtal + rounding till posit)
(define (posit+ p1 p2 n es)
(number->posit (+ (posit->number p1 n es) (posit->number p2 n es)) n es))

(define (posit- p1 p2 n es)
(number->posit (- (posit->number p1 n es) (posit->number p2 n es)) n es))

(define (posit* p1 p2 n es)
(number->posit (* (posit->number p1 n es) (posit->number p2 n es)) n es))

(define (posit/ p1 p2 n es)
(number->posit (/ (posit->number p1 n es) (posit->number p2 n es)) n es))

;; Exempel på användning (kommentera bort eller kör i REPL):
;; (define n 16)
;; (define es 1)
;; (define a (number->posit 3.14 n es)) ;; -> posit för 3.14
;; (define b (number->posit 2.0 n es))
;; (posit+ a b n es) ;; addition
;; (posit->number a n es) ;; tillbaka till tal
</pre>

Racket/Posits

Anders — Sun, 05 Apr 2026 13:01:35 GMT

Anders raderade sidan Racket/Posits innehållet var: "<pre> #lang racket ;;;;; ;; En enkel implementation av Posists eller Unum typ III ;; i Racket för skojs skull och för att lära sig mer ;; ;; Täpp-Anders Sikvall anders@sikvall.se 2026-04-04 ;; ;; Posit representeras som ett heltal (bitmönster, 0 till 2^n-1). ;; Parametrar: n = totalt antal bits, es = antal exponent-bits (t.ex. n=16, es=1 för posit16). ;; Innehåller:...", den enda som skrivit var "Anders" (diskussion)

Racket/Neural

Anders — Sun, 05 Apr 2026 13:01:16 GMT

Skapade sidan med '<pre> #lang racket ;;;;; ;; Neuralt nät implementerad i Racket ;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se ;;;;; ;;;;; NEURALT NÄT ;;; ;; Detta program implementerar ett litet neuralt nät och tränar det på sannings- ;; tabellen för XOR. Efter några tusen epoker ska prediktionerna ligga extremt nära ;; följande: ;; ;; a,b → a XOR b ;; 0,0 → 0 ;; 0,1 → 1 ;; 1,0 → 1 ;; 1,1 → 0 ;; ;; Implementationen har två input-neuroner för a...'

Ny sida

<pre>
#lang racket

;;;;;
;; Neuralt nät implementerad i Racket
;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se
;;;;;

;;;;; NEURALT NÄT
;;;
;; Detta program implementerar ett litet neuralt nät och tränar det på sannings-
;; tabellen för XOR. Efter några tusen epoker ska prediktionerna ligga extremt nära
;; följande:
;;
;; a,b → a XOR b
;; 0,0 → 0
;; 0,1 → 1
;; 1,0 → 1
;; 1,1 → 0
;;
;; Implementationen har två input-neuroner för a och b
;; det finns 5 interna (dolda neuroner) som tränas av indatat
;; det finns 1 output-neuron som ger svaret
;;
;;;;; Kodens uppbyggnad och de olika funktionernas användning
;;
;; sigmoid, sigmoid-deriv Sigmoid-kurva och derivata för backpropagation
;;
;; random-matrix, met-vec-mul Grundläggande linalg
;; outer-product; vec-add
;;
;; struct nn Nätverksstruktur, lagrar vikter och bias
;;
;; forward Beräknar prediktion
;;
;; train-step En iteration av backpropagation
;;
;; train Kör många epoker av in och förväntat utdata för
;; att träna modellen
;;
;; predict Använder nätverket på ny data!
;;
;;
;;;;; Viktiga delar
;;
;; * sigmoid mappar alla värden steglöst till intervallet (0,1)
;; * derivatan används i backpropagation för att räkna ut gradienten
;;
;; w1: vikter mellan input och hidden layer (5x2 matris)
;; b1: bias för hidden layer (5-vektor)
;; w2: viktar mellan hidden och output (1x5 matris)
;; b2: bias för output (1-vektor)
;;
;; Forward pass
;;
;; 1. Beräkna aktivering i hidden layer
;; z1 = W1 * input + b1
;; h = rho z1
;; 2. Beräkna output
;; z2 = W2 * h +b2
;; output = rho(z2)
;;
;; Backpropagation (uppdatering av viktningen)
;;
;; Hjärtat i träningen av ett neuralt nät. Algorimen är "gradient descent" med batch-
;; storlek 1.
;;
;; 1. Forward pass hidden → output
;; 2. Output-felet
;; delta = (output - target) X rho' (output)
;; 3. Hidden-felet
;; delta hidden = (W2/T * delta out) X rho' (hidden)
;; 4. Uppdatera vikternas gradienter
;; W2 ← W2 - nabla * delta out * h^T
;; W1 ← W1 - nabla * delta hidden * input^T
;; 5. Bias uppdateras på samma sätt (jo det är en genväg)
;;

(require math/base)

;; ========================================
;; Aktiveringsfunktioner
;; ========================================
(define (sigmoid x)
(/ 1.0 (+ 1.0 (exp (- x)))))

(define (sigmoid-deriv y) ; y måste redan vara sigmoid(x)
(* y (- 1.0 y)))

;; ========================================
;; Matris-/vektorhjälp (enkel version)
;; ========================================
(define (random-matrix rows cols)
(build-vector rows
(λ (_) (build-vector cols (λ (_) (- (* 2.0 (random)) 1.0))))))

(define (vec-add v1 v2) ; elementvis addition av två vektorer
(build-vector (vector-length v1)
(λ (i) (+ (vector-ref v1 i) (vector-ref v2 i)))))

(define (scalar-mul s v)
(build-vector (vector-length v) (λ (i) (* s (vector-ref v i)))))

(define (outer-product v1 v2) ; v1 kolumn × v2 rad → matris
(build-vector (vector-length v1)
(λ (i)
(build-vector (vector-length v2)
(λ (j) (* (vector-ref v1 i) (vector-ref v2 j)))))))

(define (mat-vec-mul M v) ; M (rows×cols) × v (cols)
(build-vector (vector-length M)
(λ (i)
(for/sum ([j (in-range (vector-length v))])
(* (vector-ref (vector-ref M i) j)
(vector-ref v j))))))

(define (transpose M)
(build-vector (vector-length (vector-ref M 0))
(λ (j)
(build-vector (vector-length M)
(λ (i) (vector-ref (vector-ref M i) j))))))

;; ========================================
;; Neuralt nätverk
;; ========================================
(struct nn (w1 b1 w2 b2) #:transparent)

(define (make-nn in-size hidden-size out-size)
(nn (random-matrix hidden-size in-size)
(make-vector hidden-size 0.0)
(random-matrix out-size hidden-size)
(make-vector out-size 0.0)))

(define (forward net input) ; input är en vektor t.ex. #(0 0)
(let* ([z1 (vec-add (mat-vec-mul (nn-w1 net) input)
(nn-b1 net))]
[h (build-vector (vector-length z1) (λ (i) (sigmoid (vector-ref z1 i))))]
[z2 (vec-add (mat-vec-mul (nn-w2 net) h)
(nn-b2 net))]
[o (build-vector (vector-length z2) (λ (i) (sigmoid (vector-ref z2 i))))])
(values o h)))

(define (train-step net input target lr)
(let-values ([(output hidden) (forward net input)])
(let* ([out-err (build-vector (vector-length output)
(λ (i) (- (vector-ref output i)
(vector-ref target i))))]
[out-delta (build-vector (vector-length output)
(λ (i) (* (vector-ref out-err i)
(sigmoid-deriv (vector-ref output i)))))]

[hidden-err (mat-vec-mul (transpose (nn-w2 net)) out-delta)]
[hidden-delta (build-vector (vector-length hidden)
(λ (i) (* (vector-ref hidden-err i)
(sigmoid-deriv (vector-ref hidden i)))))]

;; Uppdateringar
[dw2 (outer-product out-delta hidden)]
[new-w2 (build-vector (vector-length (nn-w2 net))
(λ (i)
(build-vector (vector-length (vector-ref (nn-w2 net) i))
(λ (j) (- (vector-ref (vector-ref (nn-w2 net) i) j)
(* lr (vector-ref (vector-ref dw2 i) j)))))))]
[new-b2 (build-vector (vector-length (nn-b2 net))
(λ (i) (- (vector-ref (nn-b2 net) i)
(* lr (vector-ref out-delta i)))))]

[dw1 (outer-product hidden-delta input)]
[new-w1 (build-vector (vector-length (nn-w1 net))
(λ (i)
(build-vector (vector-length (vector-ref (nn-w1 net) i))
(λ (j) (- (vector-ref (vector-ref (nn-w1 net) i) j)
(* lr (vector-ref (vector-ref dw1 i) j)))))))]
[new-b1 (build-vector (vector-length (nn-b1 net))
(λ (i) (- (vector-ref (nn-b1 net) i)
(* lr (vector-ref hidden-delta i)))))])

(nn new-w1 new-b1 new-w2 new-b2))))

;; ========================================
;; Skriv ut vikter och bias – snygg tabell (fixad version)
;; ========================================
(define (print-nn net)
(printf "\n=== NEURALT NÄTVERK - VIKTER OCH BIAS ===\n\n")

;; Hjälpfunktion för att formatera tal snyggt (med minustecken på rätt plats)
(define (fmt x)
(~r x
#:min-width 10
#:precision '(= 4)
#:sign #f)) ; #f = visa minus för negativa, inget tecken för positiva

;; W1: Vikter från input till hidden (5×2)
(printf "W1 (Hidden × Input):\n")
(printf " Input0 Input1\n")
(for ([i (in-range (vector-length (nn-w1 net)))])
(printf "Hidden~a " i)
(for ([j (in-range 2)])
(printf "~a " (fmt (vector-ref (vector-ref (nn-w1 net) i) j))))
(printf "\n"))
(printf "\n")

;; b1: Bias för hidden layer
(printf "b1 (Bias hidden layer):\n")
(for ([i (in-range (vector-length (nn-b1 net)))])
(printf "~a " (fmt (vector-ref (nn-b1 net) i))))
(printf "\n\n")

;; W2: Vikter från hidden till output (1×5)
(printf "W2 (Output × Hidden):\n")
(printf " Hidden0 Hidden1 Hidden2 Hidden3 Hidden4\n")
(printf "Output ")
(for ([j (in-range 5)])
(printf "~a " (fmt (vector-ref (vector-ref (nn-w2 net) 0) j))))
(printf "\n\n")

;; b2: Bias för output
(printf "b2 (Bias output):\n")
(printf "~a\n" (fmt (vector-ref (nn-b2 net) 0)))

(printf "\n========================================\n"))

;; Träna nätverket
(define (train net data epochs lr)
(for ([ep (in-range epochs)])
(for ([sample data])
(set! net (train-step net (car sample) (cadr sample) lr)))

(when (zero? (modulo ep 500)) ; oftare än var 1000:e
(let ([loss (for/sum ([sample data])
(let-values ([(output _) (forward net (car sample))])
(let ([target (vector-ref (cadr sample) 0)]
[pred (vector-ref output 0)])
(sqr (- target pred)))))])
(printf "Epoch ~a Loss: ~a\n" ep (/ loss (length data))))))
(print-nn net)
net)

;; Prediktera
(define (predict net input)
(let-values ([(output _) (forward net input)])
output))

;; ========================================
;; XOR-exempel
;; ========================================
(define xor-data
(list (list #(0 0) #(0))
(list #(0 1) #(1))
(list #(1 0) #(1))
(list #(1 1) #(0))))

(define net (make-nn 2 5 1)) ; 2 input, 5 dolda neuroner, 1 output
(define rounds 8000) ; 2000 är i minsta laget, 5000 eller hellre 8000 är bättre
(define backpr 0.7)
(printf "Tränar XOR-problemet i ~a rundor med backprop styrka ~a\n" rounds backpr)
(set! net (train net xor-data rounds backpr))

(printf "\n=== Testresultat ===\n")
(for ([sample xor-data])
(let ([pred (vector-ref (predict net (car sample)) 0)])
(printf "Input ~a → Förväntat: ~a Predikterat: ~a\n"
(car sample)
(vector-ref (cadr sample) 0)
(if (> pred 0.5) 1.0 0.0))))
</pre>

Racket/Neural

Anders — Sun, 05 Apr 2026 13:01:12 GMT

Anders raderade sidan Racket/Neural innehållet var: "<pre> #lang racket ;;;;; ;; Neuralt nät implementerad i Racket ;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se ;;;;; ;;;;; NEURALT NÄT ;;; ;; Detta program implementerar ett litet neuralt nät och tränar det på sannings- ;; tabellen för XOR. Efter några tusen epoker ska prediktionerna ligga extremt nära ;; följande: ;; ;; a,b → a XOR b ;; 0,0 → 0 ;;...", den enda som skrivit var "Anders" (diskussion)

Racket/Genetic

Anders — Sun, 05 Apr 2026 13:00:43 GMT

Skapade sidan med '<pre> #lang racket ;;;;; ;; Genetisk algoritm implementerad i Racket ;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se ;;;;; ;; ================================================================ ;; Genetisk algoritm – Hitta kromosom med: ;; 1. De första 10 bitarna = 1 ;; 2. Totalt antal 1:or så nära 50 som möjligt ;; ================================================================ ;; --------------------- Parametrar --------------------- (define populatio...'

Ny sida

<pre>

#lang racket

;;;;;
;; Genetisk algoritm implementerad i Racket
;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se
;;;;;

;; ================================================================
;; Genetisk algoritm – Hitta kromosom med:
;; 1. De första 10 bitarna = 1
;; 2. Totalt antal 1:or så nära 50 som möjligt
;; ================================================================

;; --------------------- Parametrar ---------------------
(define population-size 100)
(define chromosome-length 200)
(define generations 5000)
(define mutation-rate 0.01)

;; --------------------- Hjälpfunktioner ---------------------

;; Skapar en slumpmässig kromosom (lista med 0 och 1)
(define (random-chromosome)
(for/list ([_ (in-range chromosome-length)])
(random 2)))

;; Fitness-funktion
;; - 1000 poäng om de första 6 bitarna är alla 1:or
;; - upp till 1000 poäng om antalet 1:or är exakt 50
(define (fitness chrom)
(define prefix-5 (take chrom 5))
(define num-ones (apply + chrom))

(define prefix-bonus (if (andmap (λ (x) (= x 1)) prefix-5) 1000 0))
(define distance (abs (- num-ones 50)))

(+ prefix-bonus (- 1000 distance)))

;; Tournament selection (storlek 5)
(define (select-parent population)
(define tournament-size 5)
(argmax fitness
(for/list ([_ (in-range tournament-size)])
(list-ref population (random (length population))))))

;; Single-point crossover
(define (crossover parent1 parent2)
(define point (add1 (random (sub1 chromosome-length))))
(append (take parent1 point)
(drop parent2 point)))

;; Mutation
(define (mutate chrom)
(for/list ([gene chrom])
(if (< (random) mutation-rate)
(- 1 gene)
gene)))

;; Skapar nästa generation (utan elitism ännu)
(define (next-generation population)
(for/list ([_ (in-range population-size)])
(define p1 (select-parent population))
(define p2 (select-parent population))
(mutate (crossover p1 p2))))

;; --------------------- Huvudalgoritm ---------------------

(define (genetic-algorithm)
(printf "Startar genetisk algoritm...\n")
(printf "Mål: Första 5 bitar = 1 och totalt ~a ettor\n\n" 50)

(define initial-population
(for/list ([_ (in-range population-size)])
(random-chromosome)))

(define (evolve population generation)
(define best (argmax fitness population))
(define best-fitness (fitness best))
(define num-ones (apply + best))
(define prefix-ok? (andmap (λ (x) (= x 1)) (take best 5)))

(printf "Gen ~a | Fitness: ~a | Ettor: ~a | Prefix OK: ~a\n"
(~a generation #:width 4 #:align 'right)
best-fitness
num-ones
(if prefix-ok? "Ja" "Nej"))

(cond
[(= best-fitness 2000)
(printf "\n=== PERFEKT LÖSNING HITTAD! ===\n")
(printf "Generation: ~a\n" generation)
(printf "Kromosom: ~a\n" best)
(printf "Antal ettor: ~a\n" num-ones)]

[(>= generation generations)
(printf "\n=== Max generationer nådda ===\n")
(printf "Bästa lösning:\n")
(printf " Fitness: ~a\n" best-fitness)
(printf " Antal ettor: ~a\n" num-ones)
(printf " Första 10: ~a\n" (take best 10))]

[else
(evolve (next-generation population) (add1 generation))]))

(evolve initial-population 0))

;; --------------------- Kör programmet ---------------------
(genetic-algorithm)

<pre>

Racket/Genetic

Anders — Sun, 05 Apr 2026 13:00:38 GMT

Anders raderade sidan Racket/Genetic innehållet var: "<pre> #lang racket ;;;;; ;; Genetisk algoritm implementerad i Racket ;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se ;;;;; ;; ================================================================ ;; Genetisk algoritm – Hitta kromosom med: ;; 1. De första 10 bitarna = 1 ;; 2. Totalt antal 1:or så nära 50 som möjligt ;; ==========================================...", den enda som skrivit var "Anders" (diskussion)

Racket/Lille-GUI

Anders — Sun, 05 Apr 2026 12:59:54 GMT

Skapade sidan med '<pre> #lang racket/gui ;;;;; ;; Riktigt Enkelt GUI-Demo implementerad i Racket ;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se ;;;;; ;; Skapa huvudfönstret (define frame (new frame% [label "Racket GUI Demo"] [width 520] [height 420])) ;; Meny (define menu-bar (new menu-bar% [parent frame])) (define menu-file (new menu% [label "Arkiv"] [parent menu-bar])) (new menu-item% [label "Öppna..."] [parent menu-file] [callback (λ (i e) (mess...'

Ny sida

<pre>
#lang racket/gui

;;;;;
;; Riktigt Enkelt GUI-Demo implementerad i Racket
;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se
;;;;;

;; Skapa huvudfönstret
(define frame
(new frame%
[label "Racket GUI Demo"]
[width 520]
[height 420]))

;; Meny
(define menu-bar (new menu-bar% [parent frame]))

(define menu-file (new menu% [label "Arkiv"] [parent menu-bar]))
(new menu-item% [label "Öppna..."] [parent menu-file]
[callback (λ (i e) (message-box "Öppna" "Filöppning simulerad"))])
(new menu-item% [label "Spara"] [parent menu-file]
[callback (λ (i e) (message-box "Spara" "Filen sparad!"))])
(new separator-menu-item% [parent menu-file])
(new menu-item% [label "Avsluta"] [parent menu-file]
[callback (λ (i e) (send frame show #f))])

(define menu-help (new menu% [label "Hjälp"] [parent menu-bar]))
(new menu-item% [label "Om programmet"] [parent menu-help]
[callback (λ (i e) (message-box "Om" "Racket GUI Demo\nPedagogisk exempel"))])

;; Lite layouting av dialogen
(define main-panel
(new vertical-panel% [parent frame] [spacing 12] [border 15]))

;; Rubrik
(new message%
[parent main-panel]
[label "Välkommen till Racket GUI-demo!"])

;; Input-fält, 2 st, namn och epost
(define name-field
(new text-field% [parent main-panel] [label "Namn:"] [init-value "Anna Andersson"]))

(define email-field
(new text-field% [parent main-panel] [label "E-post:"] [init-value "anna@example.com"]))

;; Radio buttons för att välja färg
(define color-group
(new group-box-panel% [parent main-panel] [label "Favoritfärg"]))

(define color-radio
(new radio-box% [parent color-group] [label #f]
[choices '("Röd" "Grön" "Blå" "Gul")]
[style '(vertical)]))

;; Knappar för rensa och skicka
(define btn-panel
(new horizontal-panel% [parent main-panel] [alignment '(center center)] [spacing 20]))

(new button% [parent btn-panel] [label "Rensa"]
[callback (λ (b e)
(send name-field set-value "")
(send email-field set-value "")
(send color-radio set-selection 0))])

(new button% [parent btn-panel] [label "Skicka"] [style '(border)]
[callback (λ (b e)
(define name (send name-field get-value))
(define email (send email-field get-value))
(define color (list-ref '("Röd" "Grön" "Blå" "Gul")
(send color-radio get-selection)))
(message-box "Tack!"
(format "Hej ~a!\n\nE-post: ~a\nFavoritfärg: ~a"
name email color)))])

;; Centrera fönstret och starta GUI
(send frame center)
(send frame show #t)

<pre>

Racket/Lille-GUI

Anders — Sun, 05 Apr 2026 12:59:47 GMT

Anders raderade sidan Racket/Lille-GUI Före radering: "<pre> #lang racket/gui ;;;;; ;; Riktigt Enkelt GUI-Demo implementerad i Racket ;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se ;;;;; ;; Skapa huvudfönstret (define frame (new frame% [label "Racket GUI Demo"] [width 520] [height 420])) ;; Meny (define menu-bar (new menu-bar% [parent frame])) (define menu-file (new menu% [label "Arkiv"] [parent menu-bar])) (new menu-item% [label "Öppna..."] [parent menu-file] [callback (λ (i e) (message-..."

Racket/Personreg

Anders — Sun, 05 Apr 2026 12:59:23 GMT

Skapade sidan med '<pre> #lang racket ;;;;; ;; Enkel personinfodatabas implementerad i Racket ;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se ;;;;; ;; Global lista som håller alla personer, just nu tom (define personer '()) ;; Skapa en person med namngivna parametrar (define (skapa-person #:förnamn förnamn #:efternamn efternamn #:ålder ålder #:stad [stad ""] ;Valfria parametrar med defaultvärden #:telefon [telefon ""])...'

Ny sida

<pre>
#lang racket

;;;;;
;; Enkel personinfodatabas implementerad i Racket
;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se
;;;;;

;; Global lista som håller alla personer, just nu tom
(define personer '())

;; Skapa en person med namngivna parametrar
(define (skapa-person
#:förnamn förnamn
#:efternamn efternamn
#:ålder ålder
#:stad [stad ""] ;Valfria parametrar med defaultvärden
#:telefon [telefon ""])
(define person (list (cons 'förnamn förnamn) ;när man consar par såhär
(cons 'efternamn efternamn) ;måste man använda car/cdr!
(cons 'ålder ålder)
(cons 'stad stad)
(cons 'telefon telefon)))

(set! personer (cons person personer)) ; lägger till en person i listan personer och returnerar
person) ; sedan samma person

;; Sökfunktion (oförändrad)
(define hitta-person
(make-keyword-procedure
(lambda (keywords keyword-values . rest)
(if (empty? keywords)
personer
(filter (λ (person)
(for/and ([kw keywords]
[val keyword-values])
(let ([field-key (string->symbol (keyword->string kw))])
(let ([found (assoc field-key person)])
(and found
(equal? (string-downcase (format "~a" val))
(string-downcase (format "~a" (cdr found)))))))))
personer)))))

;; Pretty-print funktioner
(define (pretty-print-person person)
(printf " Förnamn: ~a\n" (cdr (assoc 'förnamn person))) ;här går det inte använda rest
(printf " Efternamn: ~a\n" (cdr (assoc 'efternamn person))) ;för det är inte en lista, det
(printf " Ålder: ~a\n" (cdr (assoc 'ålder person))) ;är ett consat par (ålder . 34)

(let ([stad (cdr (assoc 'stad person))])
(when (and stad (not (equal? stad "")))
(printf " Stad: ~a\n" stad)))

(let ([telefon (cdr (assoc 'telefon person))])
(when (and telefon (not (equal? telefon "")))
(printf " Telefon: ~a\n" telefon)))

(newline))

(define (pretty-print-persons lst)
(if (empty? lst)
(displayln " Inga personer hittades.")
(for ([p (reverse lst)])
(pretty-print-person p))))

;; Spara och ladda – Lispformat (.dat)
(define data-fil "personer.dat") ;default filnamn

(define (spara-personer [filnamn data-fil]) ;men i anrop kan du ge eget namn
(with-output-to-file filnamn
(λ () (write personer))
#:exists 'replace) ;om filen finns, skriv över den
(printf "* Sparat ~a personer till \"~a\"\n"
(length personer) filnamn))

(define (ladda-personer [filnamn data-fil])
(if (file-exists? filnamn)
(begin
(set! personer (with-input-from-file filnamn read))
(printf "* Laddat ~a personer från \"~a\"\n" (length personer) filnamn))
(printf "! Filen \"~a\" finns inte.\n" filnamn)))

;; Spara och ladda – CSV-format (för enkel redigering)
(require csv-writing csv-reading)
(define csv-fil "personer.csv")

;; Hjälpfunktion: person → CSV-rad
(define (person->csv-row person)
(list (format "~a" (cdr (assoc 'förnamn person)))
(format "~a" (cdr (assoc 'efternamn person)))
(format "~a" (cdr (assoc 'ålder person)))
(format "~a" (cdr (assoc 'stad person)))
(format "~a" (cdr (assoc 'telefon person)))))

;; SPARA till CSV
(define (spara-personer-csv [filnamn csv-fil])
(define rubriker (list (list "Förnamn" "Efternamn" "Ålder" "Stad" "Telefon")))
(define rader (map person->csv-row (reverse personer))) ; reverse så ordningen blir "naturlig"

(with-output-to-file filnamn #:exists 'replace
(λ ()
(display-table rubriker)
(display-table rader)))

(printf "* Sparat ~a personer till CSV-filen \"~a\"\n" (length personer) filnamn))

;; LADDA från CSV
(define (ladda-personer-csv [filnamn csv-fil])
(if (file-exists? filnamn)
(let* ([reader (make-csv-reader (open-input-file filnamn))]
[all-rows (csv->list reader)] ;konvertera från csv till Lisp lista
[data-rows (if (empty? all-rows) '() (rest all-rows))]) ; hoppa över rubrik-rad

(define nya-personer
(for/list ([row data-rows])
(list (cons 'förnamn (list-ref row 0))
(cons 'efternamn (list-ref row 1))
(cons 'ålder (list-ref row 2)) ; behåll som sträng eller konvertera
(cons 'stad (list-ref row 3)) ; med string->number om du vill
(cons 'telefon (list-ref row 4)))))

(set! personer (append nya-personer personer)) ; eller (set! personer nya-personer) om du vill ersätta
(printf "* Laddat ~a personer från CSV-filen \"~a\"\n" (length nya-personer) filnamn))
(printf "! CSV-filen \"~a\" finns inte.\n" filnamn)))

;; SORTERA PERSONER
;; Sorterar först på efternamn över hela listan
;; därefter på efternamn. Då blir det som det ska
(define (sortera-personer)
;; Steg 1: Sortera på förnamn
(set! personer
(sort personer
(λ (p1 p2)
(string-ci<? (cdr (assoc 'förnamn p1)) ;string-ci är "string case insensitive"
(cdr (assoc 'förnamn p2))))))

;; Steg 2: Sortera på efternamn (detta blir den slutgiltiga ordningen)
(set! personer
(sort personer
(λ (p1 p2)
(string-ci<? (cdr (assoc 'efternamn p1))
(cdr (assoc 'efternamn p2))))))

personer) ; returnerar den sorterade listan (bra för kedjad användning)

;; ================================================================
;; Exempel på användning
;; ================================================================

;; Skapa testpersoner, detta behöver vi bara göra en gång för sedan skrivs den till disk och
;; vi behöver därefter bara hämta den vid behov!

(skapa-person #:förnamn "Anna" #:efternamn "Andersson" #:ålder 34 #:stad "Stockholm" #:telefon "070-123 45 67")
(skapa-person #:förnamn "Rickard" #:efternamn "Nilsson" #:ålder 28 #:stad "Kista")
(skapa-person #:förnamn "Enar" #:efternamn "Nilsson" #:ålder "74" #:stad "Färjestaden")
(skapa-person #:förnamn "Anna" #:efternamn "Svensson" #:ålder 45 #:stad "Malmö")
(skapa-person #:förnamn "Johan" #:efternamn "Larsson" #:ålder 31 #:stad "Stockholm")

(sortera-personer)

(spara-personer-csv "personlista.csv")

(displayln "=== Personer efter skapande ===")
(pretty-print-persons (hitta-person))

;; Spara både binärt och CSV
(displayln "\n=== Sparar till disk (både .dat och .csv) ===")
(spara-personer "personlista.dat")
(spara-personer-csv "personlista.csv")

;; Rensa minnet (simulerar omstart)
(set! personer '())
(displayln "\n=== Listan rensad ===")
(pretty-print-persons (hitta-person))

;; Ladda tillbaka
(displayln "\n=== Laddar från Lispdata ===")
(ladda-personer "personlista.dat")
(pretty-print-persons (hitta-person))

(set! personer '()) ; Nolla listan igen

(ladda-personer-csv "personlista.csv")
(displayln "\n=== Personer efter laddning från CSV ===")
(pretty-print-persons (hitta-person))

;; Exempel på sökning efter laddning
(displayln "\n=== Sök efter laddning (förnamn anna) ===")
(pretty-print-persons (hitta-person #:förnamn "anna"))
</pre>

Racket/Personreg

Anders — Sun, 05 Apr 2026 12:59:16 GMT

Anders raderade sidan Racket/Personreg Före radering: "<pre> #lang racket ;;;;; ;; Enkel personinfodatabas implementerad i Racket ;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se ;;;;; ;; Global lista som håller alla personer, just nu tom (define personer '()) ;; Skapa en person med namngivna parametrar (define (skapa-person #:förnamn förnamn #:efternamn efternamn #:ålder ålder #:stad [stad ""] ;Valfria parametrar med defaultvärden #:telefon [telefon ""]) (def..."

Racket/Hexdump

Anders — Sun, 05 Apr 2026 12:58:53 GMT

Skapade sidan med '<pre> #lang racket ;;;;; ;; Hexdump implementerad i Racket ;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se ;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;; ;; SYNOPSIS ;; racket hexdump.rkt [ OPTIONS ] filename ;; ;; OPTIONS ;; -h Gives a short help text to the utility ;; --bytes-per-line, -n Determines how many bytes are decoded per line (default 16) ;; --hex, -x Show only hex dump ;; --ascii, -a...'

Ny sida

<pre>
#lang racket

;;;;;
;; Hexdump implementerad i Racket
;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se
;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SYNOPSIS
;; racket hexdump.rkt [ OPTIONS ] filename
;;
;; OPTIONS
;; -h Gives a short help text to the utility
;; --bytes-per-line, -n Determines how many bytes are decoded per line (default 16)
;; --hex, -x Show only hex dump
;; --ascii, -a Show only ASCII dump

(require racket/cmdline)

(define (hexdump-file filename
#:only-hex? [only-hex? #f]
#:only-ascii? [only-ascii? #f]
#:bytes-per-line [n 16])
(printf "Läser fil: ~a (~a bytes)\n\n" filename (file-size filename))
(call-with-input-file filename
(λ (in)
(let loop ([offset 0])
(define chunk (read-bytes n in))
(cond
[(eof-object? chunk) (void)]
[(bytes? chunk)
(define len (bytes-length chunk))
(printf "~a " (~r offset #:base 16 #:min-width 8 #:pad-string "0"))

(define show-both? (not (xor only-hex? only-ascii?)))

(cond
[(and only-hex? (not show-both?))
(for ([i (in-range n)])
(printf "~a " (if (< i len)
(~r (bytes-ref chunk i) #:base 16 #:min-width 2 #:pad-string "0")
" "))
(when (and (= (modulo (add1 i) 8) 0) (< i (sub1 n)))
(display " ")))
(newline)]

[(and only-ascii? (not show-both?))
(display " |")
(for ([b (in-bytes chunk)]) (display (if (and (>= b 32) (<= b 126)) (integer->char b) ".")))
(for ([_ (in-range (- n len))]) (display " "))
(display "|\n")]

[else ; båda eller ingen flagga
(for ([i (in-range n)])
(printf "~a " (if (< i len)
(~r (bytes-ref chunk i) #:base 16 #:min-width 2 #:pad-string "0")
" "))
(when (and (= (modulo (add1 i) 8) 0) (< i (sub1 n)))
(display " ")))
(display "|")
(for ([b (in-bytes chunk)]) (display (if (and (>= b 32) (<= b 126)) (integer->char b) ".")))
(for ([_ (in-range (- n len))]) (display " "))
(display "|\n")])

(loop (+ offset n))])))))

(define-values (filename only-hex? only-ascii? bytes-per-line)
(let ([only-hex? #f] [only-ascii? #f] [bytes-per-line 16])
(command-line
#:program "hexdump"
#:usage-help "Användning: racket hexdump.rkt [alternativ] <fil>"
#:once-each
[("-x" "--hex") "Visa endast hex-delen" (set! only-hex? #t)]
[("-a" "--ascii") "Visa endast ASCII-delen" (set! only-ascii? #t)]
[("-n" "--bytes-per-line") n
"Antal bytes per rad (standard: 16)" (let ([num (string->number n)]) (when num (set! bytes-per-line num)))]
#:args (filename)
(values filename only-hex? only-ascii? bytes-per-line))))

(if (not (file-exists? filename))
(printf "Fel: Filen \"~a\" finns inte.\n" filename)
(hexdump-file filename
#:only-hex? only-hex?
#:only-ascii? only-ascii?
#:bytes-per-line bytes-per-line))
</pre>

Racket/Hexdump

Anders — Sun, 05 Apr 2026 12:58:45 GMT

Anders raderade sidan Racket/Hexdump Före radering: "<pre> #lang racket ;;;;; ;; Hexdump implementerad i Racket ;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se ;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;; ;; SYNOPSIS ;; racket hexdump.rkt [ OPTIONS ] filename ;; ;; OPTIONS ;; -h Gives a short help text to the utility ;; --bytes-per-line, -n Determines how many bytes are decoded per line (default 16) ;; --hex, -x Show only hex dump ;; --ascii, -a S..."

Racket/Erastothenes

Anders — Sun, 05 Apr 2026 12:57:37 GMT

Skapade sidan med '<pre> #lang racket ;;;;; ;; Erastothenes såll implementerad i Racket ;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se ;;;;; (define (primes-between start stop) (cond [(> start stop) '()] [else ; Skapa en bool-vektor för intervallet [0..stop] (define sieve (make-vector (+ stop 1) #t)) ; 0 och 1 är inte primtal (vector-set! sieve 0 #f) (vector-set! sieve 1 #f) ; Såll: markera multiplar ; Går från 2 till (...'

Ny sida

<pre>
#lang racket

;;;;;
;; Erastothenes såll implementerad i Racket
;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se
;;;;;

(define (primes-between start stop)
(cond
[(> start stop) '()]
[else
; Skapa en bool-vektor för intervallet [0..stop]
(define sieve (make-vector (+ stop 1) #t))

; 0 och 1 är inte primtal
(vector-set! sieve 0 #f)
(vector-set! sieve 1 #f)

; Såll: markera multiplar
; Går från 2 till (roten ur stop) +1
; inre vektorn går från i^2 till stop med steglängden i
; och markerar multiplarna av i genom hela vektorfältet
(for ([i (in-range 2 (add1 (integer-sqrt stop)))])
(when (vector-ref sieve i)
(for ([j (in-range (* i i) (add1 stop) i)])
(vector-set! sieve j #f))))

; Samla ihop primtal i intervallet [start, stop]
(for/list ([i (in-range (max start 2) (add1 stop))]
#:when (vector-ref sieve i))
i)]))

; Exempel på användning:
(primes-between 100000 200000) ; funkar snabbt även för stora tal
</pre>

Racket/Erastothenes

Anders — Sun, 05 Apr 2026 12:57:25 GMT

Anders raderade sidan Racket/Erastothenes Författarens begäran: Före radering: "<pre> #lang racket ;;;;; ;; Erastothenes såll implementerad i Racket ;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se ;;;;; (define (primes-between start stop) (cond [(> start stop) '()] [else ; Skapa en bool-vektor för intervallet [0..stop] (define sieve (make-vector (+ stop 1) #t)) ; 0 och 1 är inte primtal (vector-set! sieve 0 #f) (vector-set! sieve 1 #f) ; Såll: markera multiplar ; Går från...

Racket/Multitråd

Anders — Sun, 05 Apr 2026 12:55:47 GMT

Skapade sidan med '<pre>#lang racket ;;;;; ;; Multitrådad demo ;; Täpp-Anders Sikvall, anders@sikvall.se, 2006-04-04 ;; Racketkurs. ;; Simulerar tidsödande arbete genom att pausa tråden en slumpmässig tid (define (random-sleep min-sec max-sec) (sleep (+ min-sec (* (random) (- max-sec min-sec))))) ;; En arbetare körs i en egen tråd och lyssnar på work-channel (define (start-worker id work-channel result-channel) (thread (λ () (let loop () ;; Vänta på att f...'

Ny sida

<pre>#lang racket

;;;;;
;; Multitrådad demo
;; Täpp-Anders Sikvall, anders@sikvall.se, 2006-04-04
;; Racketkurs.

;; Simulerar tidsödande arbete genom att pausa tråden en slumpmässig tid
(define (random-sleep min-sec max-sec)
(sleep (+ min-sec (* (random) (- max-sec min-sec)))))

;; En arbetare körs i en egen tråd och lyssnar på work-channel
(define (start-worker id work-channel result-channel)
(thread
(λ ()
(let loop ()
;; Vänta på att få ett meddelande från arbetskön
(match (channel-get work-channel)
;; Om meddelandet är 'done', avsluta loopen och därmed tråden
['done
(printf "Arbetare ~a: Avslutar.\n" id)]

;; Om meddelandet är ett tal, utför beräkningen
[n
(printf "Arbetare ~a: Bearbetar värde ~a...\n" id n)
(random-sleep 0.1 0.4)

;; Skicka tillbaka resultatet.
;; OBS: Detta blockerar arbetaren tills huvudtråden läser från result-channel.
(channel-put result-channel (list id (* n n)))
(loop)])))))

;; --- Huvudprogram ---

(define (main)
(define num-workers 4)
(define num-tasks 10)

;; Skapa kanaler för kommunikation
;; Dessa är synkrona (blockerande) i Racket
(define work-channel (make-channel))
(define result-channel (make-channel))

(printf "System: Startar ~a arbetstrådar.\n" num-workers)

;; Starta arbetartrådarna och spara deras referenser i en lista
(define workers
(for/list ([i (in-range num-workers)])
(start-worker i work-channel result-channel)))

;; 1. Skicka uppgifter till arbetskön.
;; Vi gör detta i en separat tråd för att säkerställa att huvudtråden
;; kan börja tömma resultat-kanalen omedelbart.
(thread
(λ ()
(for ([task (in-range 1 (add1 num-tasks))])
(channel-put work-channel task))

;; Skicka en 'done'-signal per arbetare för att stänga ner dem snyggt
(for ([_ (in-range num-workers)])
(channel-put work-channel 'done))))

;; Samla in resultaten.
(printf "System: Samlar in resultat.\n")
(for ([_ (in-range num-tasks)])
(match (channel-get result-channel)
[(list id result)
(printf "Resultat: Arbetare ~a levererade ~a\n" id result)]))

;; Vänta på att trådarna faktiskt har stängt ner.
(printf "System: Väntar på att trådar stängs ner...\n")
(for-each thread-wait workers)

(printf "System: Programmet är klart.\n"))

;; Kör programmet
(main)</pre>

Racket/Multitråd

Anders — Sun, 05 Apr 2026 12:55:33 GMT

Anders raderade sidan Racket/Multitråd innehållet var: "<pre>#lang racket ;;;;; ;; Multitrådad demo ;; Täpp-Anders Sikvall, anders@sikvall.se, 2006-04-04 ;; Racketkurs. ;; Simulerar tidsödande arbete genom att pausa tråden en slumpmässig tid (define (random-sleep min-sec max-sec) (sleep (+ min-sec (* (random) (- max-sec min-sec))))) ;; En arbetare körs i en egen tråd och lyssnar på work-channel (define (start-worke...", den enda som skrivit var "Anders" (diskussion)

Racket

Anders — Sun, 05 Apr 2026 12:35:35 GMT

Kodexempel (Sommarhack 2026)

← Äldre version		Versionen från 5 april 2026 kl. 12.35
(En mellanliggande sidversion av samma användare visas inte)
Rad 13:		Rad 13:
	= Kodexempel (Sommarhack 2026) =		= Kodexempel (Sommarhack 2026) =

	* [[Racket/Erastothenes]]		# [[Racket/Erastothenes]]
	* [[Racket/Personreg]]		# [[Racket/Hexdump]]
	* [[Racket/Lille-GUI]]		# [[Racket/Personreg]]
	* [[Racket/~~Hexdump~~]]		# [[Racket/Lille-GUI]]
	* [[Racket/~~Genetic~~]]		# [[Racket/Multitråd]]
	* [[Racket/~~Neural~~]]		# [[Racket/6502-emu]]
	* [[Racket/~~Posits~~]]		# [[Racket/Genetic]]
	* [[Racket/~~6502-emu~~]]		# [[Racket/Neural]]
			# [[Racket/Posits]]