Racket/Posits
Från Täpp-Anders
Hoppa till navigeringHoppa till sök
#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
