PasteRack.org
Paste # 41610
2021-04-04 08:06:01

Fork as a new paste.

Paste viewed 178 times.


Embed:

Erroring

  1. #lang racket
  2.  
  3. (provide leverage)
  4.  
  5. (define-syntax unwrap
  6.   (syntax-rules ()
  7.     [(_ f ... (w ...))
  8.      (f ... w ...)]))
  9.  
  10. (define-syntax helper
  11.   (syntax-rules (up)
  12.     [(_ x up f g ...)
  13.      (map (lambda (v)
  14.             (helper v f g ...))
  15.           x)]
  16.     [(_ x f)
  17.      (f x)]
  18.     [(_ x f ... up g . r)
  19.      (f ... (unwrap helper x up g r))]
  20.     [(_ x f g ...)
  21.      (f g ... x)]))
  22.  
  23. (define-syntax leverage
  24.   (syntax-rules ()
  25.     [(_ f ... x)
  26.      (helper x f ...)]))
  27.  
  28. (define (norm mat)
  29.   (leverage apply max up apply + up abs mat))
  30.  
  31. (norm '((1 2 3) (4 5 6) (7 8 9)))

=>