lambdaway :: fft

1 | list | login |load

| |

_img data/FFT.png

_h1 [[FFT]] | fft | [[dft]]

_p The Fast Fourier Transform lambdatalk code given in this page is a translation of a [[Lisp code|https://www.physik.uzh.ch/~psaha/mus/fourlisp.php]] written by [[Prasenjit Saha|https://www.physik.uzh.ch/~psaha/]], {b without any variable assignments }, and using a very reduced set of lambdatalk primitives, in order to stay close to the λ-calculus level.

_h2 1) lisp code by Prasenjit Saha

_p An elegant code to be compared with the one shown in [[FFT]] based on arrays.

{pre

; Take elements 0,2,4... and 1,3,5... of a list

(define (evens f)
  (if (null? f) '()
      (cons (car f) (evens (cddr f)))
      )
  )

(define (odds f)
  (if (null? f) '()
      (cons (cadr f) (odds (cddr f)))
      )
  )

; Length of a list

(define (len f)
    (if (null? f) 0
       (+ 1 (len (cdr f)))
       )
    )

; Multiply by exp(2 pi i k/N)

(define (phase s k N)
   (exp (/ (* 0+2i s k 3.1415926535 ) N) )
   )

(define (rotate s k N f)
   (if (null? f) '()
       (cons (*  (phase s k N) (car f))
             (rotate s (+ k 1) N (cdr f)))
       )
   )

; With these preliminaries FFT is simple

(define (four s f)
   (if (= 1 (len f)) f
       (combine s (four s (evens f)) (four s (odds f)))
       )
   )

(define (combine s ev od)
  (plusminus ev (rotate s 0 (len od) od))
  )

(define (plusminus a b)
   (append (map + a b) (map - a b))
   )

; A little test

(four -1 (four 1 '(1 -6 2 4)))  
// is supposed to return (1 -6 2 4) modulo a constant
}

_h2 2) lambdatalk code

_p 1) We suppose that lambdatalk knows nothing but this reduced set of primitives:

{pre
1) predicats on words:

'{W.equal? hello world} -> {W.equal? hello world}
'{W.equal? hello hello} -> {W.equal? hello hello}
'{W.empty? hello} -> {W.empty? hello}
'{W.empty? } -> {W.empty? }

2) two accessors on a Sequence of words:

'{S.first hello brave new world} -> {S.first hello brave new world}
'{S.rest hello brave new world} -> {S.rest hello brave new world}

3) the pair structure, (lists are supposed to be unknown):

'{def P {cons a b}} -> {def P {cons a b}}
'{car {P}} -> {car {P}}
'{cdr {P}} -> {cdr {P}}

4) and obviously real numbers with their related operators.
}

_p 2) We define useful functions to create lists and work on them

{prewrap
'{def list        // create a list from a sequence of words
 {lambda {:s}
  {if {W.empty? {S.rest :s}}
   then {cons {S.first :s} nil}
   else {cons {S.first :s} {list {S.rest :s}}}}}}
-> {def list
 {lambda {:s}
  {if {W.empty? {S.rest :s}}
   then {cons {S.first :s} nil}
   else {cons {S.first :s} {list {S.rest :s}}}}}}

'{def null?
 {lambda {:l}
  {W.equal? :l nil}}}   // nil is just a chosen word
-> {def null?
 {lambda {:l}
  {W.equal? :l nil}}}

'{def len         // compute the length of a list
 {lambda {:f}
  {if {null? :f}
   then 0
   else {+ 1 {len {cdr :f}}}}}}
-> {def len
 {lambda {:f}
  {if {null? :f}
   then 0
   else {+ 1 {len {cdr :f}}}}}}

'{def reverse     // reverse a list
 {def reverse.r
  {lambda {:a :b}
   {if {null? :a}   
    then :b
    else {reverse.r {cdr :a} {cons {car :a} :b}}}}}
 {lambda {:l}
  {reverse.r :l nil}}}
-> {def reverse
 {def reverse.r
  {lambda {:a :b}
   {if {null? :a}   
    then :b
    else {reverse.r {cdr :a} {cons {car :a} :b}}}}}
 {lambda {:l}
  {reverse.r :l nil}}}

'{def concat     // concatenate two lists
 {def concat.r
  {lambda {:a :b}
   {if {null? :b}
    then :a
    else {concat.r {cons {car :b} :a} {cdr :b}}}}}
 {lambda {:a :b}
  {concat.r :a {reverse :b}}}}
-> {def concat
 {def concat.r
  {lambda {:a :b}
   {if {null? :b}
    then :a
    else {concat.r {cons {car :b} :a} {cdr :b}}}}}
 {lambda {:a :b}
  {concat.r :a {reverse :b}}}}

'{def map  // map a function on two lists and return a list
 {def map.r 
  {lambda {:f :a :b :c}
   {if {null? :a}
    then :c
    else {map.r :f {cdr :a} {cdr :b} 
                   {cons {:f {car :a} {car :b}} :c}} }}}
 {lambda {:f :a :b}
  {map.r :f :a :b nil}}}
-> {def map
 {def map.r 
  {lambda {:f :a :b :c}
   {if {null? :a}
    then :c
    else {map.r :f {cdr :a} {cdr :b} 
                       {cons {:f {car :a} {car :b}} :c}} }}}
 {lambda {:f :a :b}
  {map.r :f :a :b nil}}}

'{def evens      // return the even terms of a list
 {lambda {:f}
  {if {null? :f}
   then nil
   else {cons {car :f} {evens {cdr {cdr :f}}}}}}}
-> {def evens
 {lambda {:f}
  {if {null? :f}
   then nil
   else {cons {car :f} {evens {cdr {cdr :f}}}}}}}
 
'{def odds      // return the odds terms of a list
 {lambda {:f}
  {if {null? :f}
   then nil
   else {cons {car {cdr :f}} {odds {cdr {cdr :f}}}}}}}
-> {def odds
 {lambda {:f}
  {if {null? :f}
   then nil
   else {cons {car {cdr :f}} {odds {cdr {cdr :f}}}}}}}
}

_p 3) We define useful functions creating complex numbers and working on them

{prewrap
'{def C.new {lambda {:x :y} {cons :x :y} }}
-> {def C.new {lambda {:x :y} {cons :x :y} }}

'{def C.mod
 {lambda {:c}
  {sqrt {+ {* {car :c} {car :c}}
           {* {cdr :c} {cdr :c}}}} }}
-> {def C.mod
 {lambda {:c}
  {sqrt {+ {* {car :c} {car :c}}
           {* {cdr :c} {cdr :c}}}} }}

'{def C.add
 {lambda {:x :y}
  {cons {+ {car :x} {car :y}}
        {+ {cdr :x} {cdr :y}}} }}
-> {def C.add
 {lambda {:x :y}
  {cons {+ {car :x} {car :y}}
        {+ {cdr :x} {cdr :y}}} }}

'{def C.sub
 {lambda {:x :y}
  {cons {- {car :x} {car :y}}
        {- {cdr :x} {cdr :y}}} }}
-> {def C.sub
 {lambda {:x :y}
  {cons {- {car :x} {car :y}}
        {- {cdr :x} {cdr :y}}} }}

'{def C.mul
 {lambda {:x :y}
  {cons {- {* {car :x} {car :y}}
           {* {cdr :x} {cdr :y}}}
        {+ {* {car :x} {cdr :y}}
           {* {cdr :x} {car :y}}}} }}
-> {def C.mul
 {lambda {:x :y}
  {cons {- {* {car :x} {car :y}}
           {* {cdr :x} {cdr :y}}}
        {+ {* {car :x} {cdr :y}}
           {* {cdr :x} {car :y}}}} }}

'{def C.exp 
 {lambda {:x}  
  {cons {* {exp {car :x}} {cos {cdr :x}}}
        {* {exp {car :x}} {sin {cdr :x}}}} }}
-> {def C.exp 
 {lambda {:x}  
  {cons {* {exp {car :x}} {cos {cdr :x}}}
        {* {exp {car :x}} {sin {cdr :x}}}} }}

}

_p 4) We define functions which are closely related to FFT:

{prewrap

'{def phase            // compute exp(i2πk/N)
 {lambda {:s :k :N}
  {C.exp {C.new 0 {/ {* 2 :s {PI} :k} :N}}}}}
-> {def phase
 {lambda {:s :k :N}
  {C.exp {C.new 0 {/ {* 2 :s {PI} :k} :N}}}}}

'{def rotate           // apply to elements of the list
 {lambda {:s :k :N :f}
  {if {null? :f}
   then nil
   else {cons {C.mul {phase :s :k :N} {car :f}}
              {rotate :s {+ :k 1} :N {cdr :f}}} }}}
-> {def rotate
 {lambda {:s :k :N :f}
  {if {null? :f}
   then nil
   else {cons {C.mul {phase :s :k :N} {car :f}}
              {rotate :s {+ :k 1} :N {cdr :f}}} }}}

'{def plusminus
 {lambda {:a :b}
  {concat {map C.add :a :b} {map C.sub :a :b}}}}
-> {def plusminus
 {lambda {:a :b}
  {concat {map C.add :a :b} {map C.sub :a :b}}}}

'{def combine
 {lambda {:s :ev :od}
  {plusminus :ev {rotate :s 0 {len :od} :od}}}}
-> {def combine
 {lambda {:s :ev :od}
  {plusminus :ev {rotate :s 0 {len :od} :od}}}}

'{def four          // compute and return the FFT list
 {lambda {:s :f}
  {if {= 1 {len :f}}
   then :f
   else {combine :s {four :s {evens :f}}
                    {four :s {odds :f}}}}}}
-> {def four
 {lambda {:s :f}
  {if {= 1 {len :f}}
   then :f
   else {combine :s {four :s {evens :f}} {four :s {odds :f}}}}}}
}

_p 5) And now we test:

{prewrap
'{def F {list {C.new 1 0}    // create a list of Cnumbers
             {C.new -6 0}
             {C.new 2 0} 
             {C.new 4 0}}}
-> {def F {list {C.new 1 0} 
             {C.new -6 0}
             {C.new 2 0} 
             {C.new 4 0}}} = {F}

'{def G {four -1 {four 1 {F}}}}      
// is supposed equal to F modulo a constant

-> {def G {four -1 {four 1 {F}}}} = {G}

which is equivalent to:
 4 * {F}
°°°
{def sample {list 
  {S.map {lambda {_} {C.new  1 0}} {S.serie 1 16}}
  {S.map {lambda {_} {C.new -1 0}} {S.serie 1 16}} }}
{sample}
{four -1 {four 1 {sample}}}
°°°
}

_p See [[FFT]] for a more interesting result.

_p {i Alain Marty 2020/08/29}

{style 
pre { box-shadow:0 0 8px #000; padding:10px; font-family:courier}
}