On Serial Substitution and Not Reading The Manual.

==================================================

; I defined no less than six functions performing serial
; substitution:
;
; (serial-substitute '(-> (A B) (B (A B)) (-> B (A C) (B C)))
;                    '((A abc) (B cde) (C xxx)))
;                     
; =>
;
; (-> (abc cde) (cde (abc cde)) (-> cde (abc xxx) (cde xxx)))
;
; until I learnt that built in primitive function "expand", in one
; of its polymorphic versions, does exactly that. However, I decided
; to publish my versions, just for archive. The final one is only
; four times slower than built in substitution.
     
(set 'substitute
  (lambda(substitute-a l b)
      (if (= l substitute-a)
          b
          (if (list? l)
              (map (lambda(x)(substitute substitute-a x b))
                   l)
              l))))

(set 'serial-substitute1
  (lambda(l A)
     (let ((result l))
       (dolist(i A)
          (set 'result (substitute (i 0) result (i 1))))
       result)))

(set 'metex
   (lambda-macro(head)
     (eval (append '(letex)
                   (list (map (lambda(x)
                                 (list (first x)
                                       (list 'quote (last x))))
                               head))
                   (args)))))
                   
(set 'serial-substitute2
     (lambda(l A)
        (eval (list 'metex A (list 'quote l)))))
        
(set 'serial-helper3 (lambda(x)(list (first x)
                                      (list 'quote (last x)))))

(set 'serial-substitute3
     (lambda(l A)
        (eval (list 'letex (map serial-helper3
                                A)
                           (list 'quote l)))))

(set 'ss4 '(metex A 'l))
(set 'serial-substitute4
     (lambda(l A)
        (eval (expand ss4 'A 'l))))
        
(set 'serial-substitute5
     (lambda(l A)
        (letex ((A A)(l l))(metex A 'l))))
           
(set 'serial-substitute6
     (lambda(F s)
        (eval (let((vars (map first s)))
                  (list 'local
                        vars
                        '(bind s)
                        (append '(expand F)
                                 (map quote vars)))))))

(set 'serial-substitute7 expand) ; this is one built in

(set 'serial-substitute8 '(lambda())) ; just to test empty loop




(set 'formula '(-> (A B) (B (A B)) (-> B (A C) (B C))))
(set 'substitution ' ((A abc) (B cde) (C xxx)))

(dolist (s '(serial-substitute1 serial-substitute2 serial-substitute3
             serial-substitute4 serial-substitute5 serial-substitute6
             serial-substitute7 serial-substitute8))
   (println s " time (ms): " (time ((eval s) formula substitution) 100000))
   (println s " result:    " ((eval s) formula substitution)))
   
(exit)

serial-substitute1 time (ms): 10681
serial-substitute1 result:    (-> (abc cde) (cde (abc cde)) (-> cde (abc xxx) (cde xxx)))
serial-substitute2 time (ms): 2084
serial-substitute2 result:    (-> (abc cde) (cde (abc cde)) (-> cde (abc xxx) (cde xxx)))
serial-substitute3 time (ms): 1544
serial-substitute3 result:    (-> (abc cde) (cde (abc cde)) (-> cde (abc xxx) (cde xxx)))
serial-substitute4 time (ms): 2114
serial-substitute4 result:    (-> (abc cde) (cde (abc cde)) (-> cde (abc xxx) (cde xxx)))
serial-substitute5 time (ms): 2134
serial-substitute5 result:    (-> (abc cde) (cde (abc cde)) (-> cde (abc xxx) (cde xxx)))
serial-substitute6 time (ms): 1174
serial-substitute6 result:    (-> (abc cde) (cde (abc cde)) (-> cde (abc xxx) (cde xxx)))
serial-substitute7 time (ms): 386
serial-substitute7 result:    (-> (abc cde) (cde (abc cde)) (-> cde (abc xxx) (cde xxx)))
serial-substitute8 time (ms): 119
serial-substitute8 result:    nil

No comments:

Post a Comment