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)

              

              

No comments:

Post a Comment