Add and Multiply Digits.

; Discussing some possible extension of Newlisp's add and mul functions
; suggested by Jeremy Dunn, I wrote these few simple functions.
; Just in case that someone is interested.

(set 'println= (lambda-macro(x)(println x " = " (eval x))))

(set 'factorial
     (lambda(n)
       (let((result 1))
         (when (> n 0)
              (for(i 1 n 1)
               (set 'result (* result i))))
          result)))
         
; one might expect that "sequence" work better than loop here,
; but sequence definition is really different, so it requires some
; changes that at the end, make definition more similar to loop.

(println= (factorial 6))
(println= (factorial 0))



(set 'double-factorial
     (lambda(n)
       (let((result 1))
        (when (> n 0)
         (for(i n 1 -2)
            (set 'result (* result i))))
         result)))

(println= (double-factorial 5))
(println= (double-factorial 6))
(println= (double-factorial 0))



(set 'add-digits
     (lambda(n)
        (apply + (map int (explode (string n))))))

(println= (add-digits 12345))



(set 'multiply-digits
      (lambda(n)
        (apply * (map int (explode (string n))))))
        
(println= (multiply-digits 12345))
            


(set 'recursively-add-digits
     (lambda(n)
        (if (< n 10)
            n
            (recursively-add-digits
               (add-digits n)))))
               
(println= (recursively-add-digits 12345))
                                       


(set 'recursively-multiply-digits
     (lambda(n)
       (if (< n 10)
           n
           (recursively-multiply-digits
                (multiply-digits n)))))
                
(println= (recursively-multiply-digits 12345))
                                       
; (factorial 6) = 720
; (factorial 0) = 1
; (double-factorial 5) = 15
; (double-factorial 6) = 48
; (double-factorial 0) = 1
; (add-digits 12345) = 15
; (multiply-digits 12345) = 120
; (recursively-add-digits 12345) = 6
; (recursively-multiply-digits 12345) = 0
;

Multiple Loops.

; Sometimes programmer needs deeply nested loops over the same
; list of values. For example,
 
 
 (dolist (i '(0 1))
   (dolist (j '(0 1))
     (dolist (k '(0 1))
        (dolist (l '(0 1))
          (println i j k l)))))
                    

; For such, relatively rare, but still realistic situations, it
; might be useful to have "multi" version of the loop, and write
; something like:
;
;
; (dolist-multi ((i j k l) '(0 1))
;                  (println i j k l))
;
;
; Such a multi loop can be used even if all variables are known only
; during runtime, using letex (or wherex defined in the previous posts.)
;
;
; (letex ((L (random-sublist '(i j k l m n o p q r s t u v))))
;   (dolist-multi (L '(0 1))
;       (println= ... )))
;
;
; I'll use recursive definition:
;
; 1° Base
; --------
;
; (dolist-multi (() ___)                   (begin
;      expr1                                   expr1
;      ...                  <===>              ...      if n # 1
;      exprn)                                  exprn)
;
;                                              expr1    in n = 1
;
; 2° Step
; --------
;
; (dolist-multi((v1 ... vn) ...)   (dolist (v1 ...)
;   expr1;                            (dolist-multi ((v2 ... vn) ...)
;   ...;             <===>               expr1
;   exprn);                              ...
;                                        exprn))
;
; First one simple, but frequently needed function that transforms
; list of expressions into single expression by inserting "begin"
; in the list - but only if it is needed. If list has only one
; expression, then this expression is returned.


(set 'list-to-single-expression
     (lambda(L)
       (if (= (length L) 1)
           (first L)
           (cons 'begin L))))


(set 'dolist-multi
     (lambda-macro(L)
       (let ((variables (first L)))
                   
         (if (empty? variables)
             (eval (list-to-single-expression (args)))
             
             (letex ((head1 (cons (first variables) (rest L)))
                     (head2 (cons (rest variables) (rest L)))
                     (body (list-to-single-expression (args))))
                                 
                     (dolist head1
                             (dolist-multi head2
                                           body)))))))

; Tests:

(dolist-multi(() (list 0 1))
   (println 5))
   
(dolist-multi((i) (list 0 1))
   (println "i = " i))
   
(dolist-multi((i j k) (list 0 1))
   (println "i =" i ", j = " j ", k = " k))


; Appears to work.
              
; However, now, when I'm here - many newlisp loops, not only dolist
; have the syntax
;
;
;          (<loop name> (<control variable> ...) <body>)
;
;
; For all of these, multi as defined here has a sense. So, it appears
; that defining multi-version of many loops is "low hanging fruit."
; It is also excelent example of the power of the Newlisp metaprogramming.
;
; I'll define the function multiloop that
;
;       *  accepts the name of the loop as argument,
;       *  generates new, multiloop macro, and
;       *  gives the appropriate name to it.


(set 'multiloop
   (lambda(loop)
     (let ((new-loop (sym (append (string loop) "-multi"))))
        
        (set new-loop
           (expand
             (lambda-macro(L)
                (let ((variables (first L)))
                            
                  (if (empty? variables)
                      (eval (list-to-single-expression (args)))
                      
                      (letex ((head1 (cons (first variables) (rest L)))
                              (head2 (cons (rest variables) (rest L)))
                              (body  (list-to-single-expression (args))))
                                          
                              (loop head1
                                    (new-loop head2
                                                  body))))))
                    'loop
                    'new-loop)))))


; Next, I'll apply multiloop on all Newlisp loops of the form
; (<loop name> (<control variable> ... ) <body>)


  (map multiloop '(doargs dolist dostring dotimes dotree for))



; TEST

; Simple expression that contains two nested multiloops.

(for-multi ((i j) 0 8 4)
   (dotimes-multi ((i j) 5) (print "*"))
   (println " i= " i ", j=" j))


; RESULT:

; ************************* i= 0, j=0
; ************************* i= 0, j=4
; ************************* i= 0, j=8
; ************************* i= 4, j=0
; ************************* i= 4, j=4
; ************************* i= 4, j=8
; ************************* i= 8, j=0
; ************************* i= 8, j=4
; ************************* i= 8, j=8

(exit)

Where is Letex!

; It is easy to oversight letex as just another of less important
; relative of let. But letex is really different. It is perfect
; if we want to use macros as functions - the topic I discussed
; several times but not nearly exhausted. For example, "for" is
; the primitive that behaves as macro:

  (for (i 1 50) (print "*"))

  (println)

; (i 1 50) and (print i) are not evaluated before "for" is called.
; If they are, (i 1 50) would cause error. But, what if I want
; (for L (print i)) where L is random choice of three different
; lists, (i 1 10), (i 1 10 2), (i 10 1 -1)?
;
; The first guess,
;
; (set 'L (amb '(i 1 10) '(i 1 10 2) '(i 10 1 -1)))
; (for L (print i))
;
; results in ERR: list expected in function for : L.
;
; Standard way of doing that would be

  (set 'L (amb '(i 1 10) '(i 1 10 2) '(i 10 1 -1)))
  (eval (append '(for) (list L) '((print i))))

  (println)

; I constructed list (for (i 1 50) (print "*")) and evaluated it.
; Semantically, everything is OK, but syntactically, this expression
; is cumbersome. That's where letex come on stage:

  (letex ((L (amb '(i 1 10) '(i 1 10 2) '(i 10 1 -1))))
         (for L (print i)))

  (println)
  
; Much simpler. However, sometimes, I find that using letex is not
; that smooth and that I, more frequently than not, write my letex
; expressions starting from the back side, like I did in this example.

; Why? Because in mathematics, and ordinary language, word "where"
; is typically used for that task. And one writes the result first,
; with some variables with meaning he'll explain later.

; Really, even in formulation of this problem, I used that word:
; "where L is random choice." Because of that, I'll define macro
; "where." Actually, I'll define wherex and where, "for completeness",
; although I ; expect that I'll always need wherex. It is simple
; addition, but it can be useful.

(set 'where
   (lambda-macro()
      (eval (append '(let)
              (cons (last (args))
                (reverse (rest (reverse (args)))))))))

(set 'wherex
   (lambda-macro()
      (eval (append '(letex)
              (cons (last (args))
                (reverse (rest (reverse (args)))))))))


; Test:


(wherex (for condition body)
       ((condition (amb '(i 1 10) '(i 1 10 2) '(i 10 1 -1)))
        (body '(println i "-"))))
        
; It works.


(exit)

More on Usenet and Google Groups Posting Frequency.

; Inspired by Xah Lee's analysis of frequency of Usenet newsgroups ; I decided to do same in Newlisp, and to add automatic processing ; and output in the form of modern, graphical user interface. ; Data about frequency of posting is collected from Google's interface ; to Usenet. For example, this is the page on address ; http://groups.google.com/group/comp.lang.pascal/about ; ; That page contains data on the posting frequency on Usenet ; group comp.lang.pascal. Here is the critical part of the ; source of the same page:   (println "The program shows frequency of Usenet posts.")   (println "Kazimir Majorinc, Institute for Programming, 2009.")   (println "Free for non-commercial use.")   (until (begin (print "\n\n\nNewsgroup [enter for exit]: ")                 (set 'group (replace " " (read-line) ""))                 (empty? group))          ;; Following read-file retrieves the content of the page in     ;; txt form.          (let ((f (read-file (format "http://groups.google.com/group/%s/about"                                 group)))           (data (list))           (max-posts/year 0))   ; / is just part of the name              (for (year 1980 (first (now)))         (let (posts/year)            (for (month 1 12)                          ;; extracting information about number of posts in              ;; given year and month:                            (when (find (format "%04d-%02d\">(.*)<" year month) f 0)                 (inc posts/year (int (replace "&nbsp;" (copy $1) "")))))                                     (when posts/year              (push (list year posts/year) data -1)              (set 'max-posts/year (max posts/year max-posts/year)))))                ;; Display - if it doesn't look good with your font,        ;; replace \219 with something else, for example #                (unless (zero? max-posts/year)           (println "\n ^ posts/year (max = " max-posts/year ")\n |")           (for (i 20 1 -1)             (println " |"                (apply append                       (map (lambda(x)                               (if (> (x 1)                                      (* i (/ max-posts/year 20)))                                   "\219\219 "                                   "   "))                             data))))           (print " +" (dup "--+" (length data) ) "-->\n ")           (dolist (j data)              (print " " (slice (string (j 0)) 2))))))              (exit)                 ;; You need installed Newlisp v10 to run this program. ;; The result will be as on the following picture: ;; Also, program will work for all "Google Groups," not only Usenet Groups.

---

Decline of Lisp Usenet.

The graphs show average number of posts per month, according to Google.

See also:

• Xah Lee, Computer Language Popularity Trend, 2006.


• Mary McGlohon, End of Usenet, 2008.


• Kazimir Majorinc, More on Usenet Posting Frequency, 2009.

The Most Probable Cond.

; The expression cond branches evaluation of the program on
; the condition which is first evaluated to be true. Theoretically
; there might be some interest in branching program on the
; condition which is *most probably true*.
;
; What does it mean? I want syntax of the following kind
;
;
; (let ((x1 0.4) (x2 0.6))
;      ((y1 0.2) (y2 0.3))
;      ((z1 0.1) (z6 0.7))
;      
;      (most-probable-cond
;              (div 1 x1 y1 zy x2 y2 z2)
;              ((< (random 0 1) x1) (println "First!"))
;              ((< (random 0 1) x2) (println "Second!"))
;              ((< (random 0 1) x3) (println "Third!"))))
;
; Semantics is: each of the clauses, in this case (< (random 0 1) x1)
; and similar, will be evaluated exactly (div 1 x1 y1 zy x2 y2 z2)
; times - where that number is evaluated only once.
; After that, program will branch on clause which evaluated to
; be true more times than others. If some clauses happened to be
; true equal number of times, then any of branches will be chosen.

; Here is Newlisp macro. It is long, because I used descriptive
; variable names and lot of prints to see how macro works. Otherwise,
; it is not really long and complicated.

(set 'most-probable-cond
    (lambda-macro(formula-for-a-number-of-evals)
       (let ((number-of-evals (eval formula-for-a-number-of-evals))
             (maximal-clause-index -1)
             (maximal-clause-successes -1))
             
            (println "Number of evals: " number-of-evals)
            (doargs(clause)
                (let ((counter-of-successes 0))
                     
                     (dotimes (this-eval number-of-evals)
                          (when (eval (first clause))
                                (inc counter-of-successes)))
                                
                     (println "Clause: " $idx
                              ". " ($args $idx)
                              ": " counter-of-successes
                              " times.")
                                 
                     (when (> counter-of-successes
                              maximal-clause-successes)
                           (set 'maximal-clause-index $idx)
                           (set 'maximal-clause-successes
                                 counter-of-successes))))
                     
            (println "Max: " maximal-clause-index
                     ". " ($args maximal-clause-index)
                     ": " maximal-clause-successes " times.")
                     
            (eval (last ($args maximal-clause-index))))))
            
; Test
            
(seed (date-value))

(let ((x1 0.4) (x2 0.6)
      (y1 0.2) (y2 0.3)
      (z1 0.1) (z2 0.7))
     
     (most-probable-cond  
             (div 1 x1 x2 y1 y2 z1 z2)
             ((< (random 0 1) x1) (println "First!"))
             ((< (random 0 1) y1) (println "Second!"))
             ((< (random 0 1) z1) (println "Third!"))))
             
; Number of evals: 992.0634921
; Clause: 0. ((< (random 0 1) x1) (println "First!")): 398 times.
; Clause: 1. ((< (random 0 1) y1) (println "Second!")): 199 times.
; Clause: 2. ((< (random 0 1) z1) (println "Third!")): 106 times.
; Max: 0. ((< (random 0 1) x1) (println "First!")): 398 times.
; First!

; Expressions like (maximal-clause-index -1) suggest that on this
; place some of "functional programming" features can be inserted.
; Really, they can - resulting in the shorter, but usually harded
; to understand definitions.

(define-macro (most-probable-cond f-n-evals)
 (let ((n-evals (eval f-n-evals)))
   (eval
     (last ((args)
            (let ((temp (map (lambda(clause counter)
                               (dotimes (dotimes-iterator n-evals)
                                        (when (eval (first clause))
                                        (inc counter)))
                                counter)
                              (args))))
                 (find (apply max temp) temp)))))))

(let ((x1 0.4) (x2 0.1)
      (y1 0.55) (y2 0.3)
      (z1 0.5) (z2 0.7))
     
     (most-probable-cond
             (div 1 x1 x2 y1 y2 z1 z2)
             ((< (random 0 1) x1) (println "First!"))
             ((< (random 0 1) y1) (println "Second!"))
             ((< (random 0 1) z1) (println "Third!"))))

(exit)

              

              

Trees, Branches and Leaves.

; We can easily imagine s-expression as a tree, for example
; '(+ (- 1 2) (+ 3 4) (- 5 (+ 6 7)))
;
;                            +-+
;                            |+|
;                           _+-+_
;                        _,'  |  `._
;                     _.'     |     `._
;                  _.'        |        `._
;                .'           |           `.
;              +-+           +-+           +-+
;              |-|           |+|           |-|
;              +-+           +-+           +-+
;             /   \         /   \         /   \
;            /     \       /     \       /     \
;           /       \     /       \     /       \
;         +-+      +-+  +-+       +-+ +-+       +-+
;         |1|      |2|  |3|       |4| |5|       |+|
;         +-+      +-+  +-+       +-+ +-+       +-+
;                                              /   \
;                                             /     \
;                                            /       \
;                                          +-+       +-+
;                                          |6|       |7|
;                                          +-+       +-+
;
; When we see it as tree, we can easily recognize branches and
; leaves of that tree - they are subexpressions of the original
; s-expression. In this case, our intuition is good enough so
; I can avoid mathematical definitions, and instead write two
; functions that return list of all branches and leafs of a given
; s-expression. By definition, original s-expression and all
; leaves are also branches.

(set 'branches
     (lambda(L)
       (if (list? L)
           (cons L (apply append (map branches (rest L))))
           (list L))))
           
(set 'leafs
     (lambda(L)
       (if (list? L)
           (apply append (map leafs (rest L)))
           (list L))))
           
(println (branches '(+ (- 1 2) (+ 3 4) (- 5 (+ 6 7)))))
(println (leafs '(+ (- 1 2) (+ 3 4) (- 5 (+ 6 7)))))

; ((+ (- 1 2) (+ 3 4) (- 5 (+ 6 7)))
; (- 1 2) 1 2 (+ 3 4) 3 4 (- 5 (+ 6 7)) 5 (+ 6 7) 6 7)
; (1 2 3 4 5 6 7)

; Note that expression '(+ 1 2) is leaf, while (quote (+ 1 2))
; isn't.
; Graph is drawn with excellent ASCII editor Jave, www.jave.de
;


(exit)