PasteRack.org
Paste # 96999
2021-04-05 15:01:00

Fork as a new paste.

Paste viewed 159 times.


Embed:

Still Errored

  1. #lang racket
  2.  
  3. (provide leverage)
  4.  
  5. (define-syntax shift
  6.   (syntax-rules ()
  7.     [(_ x f ...)
  8.      (f ... x)]))
  9.  
  10. (define-syntax unwrap
  11.   (syntax-rules ()
  12.     [(_ a ... (w ...))
  13.      (a ... w ...)]))
  14.  
  15. (define-syntax leverage
  16.   (syntax-rules (up)
  17.     [(_ up ... x)
  18.      x]
  19.     [(_ f x)
  20.      (f x)]
  21.     [(_ f ... x)
  22.      (unwrap helper-2 (helper x f ...))]))
  23.  
  24. (define-syntax helper
  25.   (syntax-rules (up)
  26.     [(_ x f ... up . r)
  27.      (unwrap shift r (helper x f ...))]
  28.     [(_ x f ...)
  29.      (x (f ...))]))
  30.  
  31. (define-syntax helper-2
  32.   (syntax-rules ()
  33.     [(_ x) x]
  34.     [(_ x (f) r ...)
  35.      (map (lambda (v)
  36.             (f (helper-2 v r ...)))
  37.           x)]
  38.     [(_ x () f ...)
  39.      (map (lambda (v)
  40.             (helper-2 v f ...))
  41.           x)]
  42.     [(_ x (f ...) g ...)
  43.      (map (lambda (v)
  44.             (f ... (helper-2 v g ...))))]))
  45.  
  46. (define (norm mat)
  47.   (leverage apply max up apply + up abs))

=>