### 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 " " (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:

### 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)