Addition chains: Difference between revisions

From Rosetta Code
Content added Content deleted
(Added EchoLisp)
m (fixed typo)
Line 34: Line 34:
(when (< lg *minlg*)
(when (< lg *minlg*)
(set! *counts* (make-vector 2 0))
(set! *counts* (make-vector 2 0))
(set! *chains* (make-vector 2 null))
(set! *chains* (make-vector 2 ""))
(set! *minlg* lg))
(set! *minlg* lg))
(vector+= *counts* idx 1)
(vector+= *counts* idx 1)
Line 75: Line 75:
(for-each task {7 14 21 29 32 42 64})
(for-each task {7 14 21 29 32 42 64})


L(7) = 4 - brauer-chains: 5 non-brauer: 0 chains: (1 2 3 4 7) null
L(7) = 4 - brauer-chains: 5 non-brauer: 0 chains: (1 2 3 4 7)
L(14) = 5 - brauer-chains: 14 non-brauer: 0 chains: (1 2 3 4 7 14) null
L(14) = 5 - brauer-chains: 14 non-brauer: 0 chains: (1 2 3 4 7 14)
L(21) = 6 - brauer-chains: 26 non-brauer: 3 chains: (1 2 3 4 7 14 21) (1 2 4 5 8 13 21)
L(21) = 6 - brauer-chains: 26 non-brauer: 3 chains: (1 2 3 4 7 14 21) (1 2 4 5 8 13 21)
L(29) = 7 - brauer-chains: 114 non-brauer: 18 chains: (1 2 3 4 7 11 18 29) (1 2 3 6 9 11 18 29)
L(29) = 7 - brauer-chains: 114 non-brauer: 18 chains: (1 2 3 4 7 11 18 29) (1 2 3 6 9 11 18 29)
L(32) = 5 - brauer-chains: 1 non-brauer: 0 chains: (1 2 4 8 16 32) null
L(32) = 5 - brauer-chains: 1 non-brauer: 0 chains: (1 2 4 8 16 32)
L(42) = 7 - brauer-chains: 78 non-brauer: 6 chains: (1 2 3 4 7 14 21 42) (1 2 4 5 8 13 21 42)
L(42) = 7 - brauer-chains: 78 non-brauer: 6 chains: (1 2 3 4 7 14 21 42) (1 2 4 5 8 13 21 42)
L(64) = 6 - brauer-chains: 1 non-brauer: 0 chains: (1 2 4 8 16 32 64) null
L(64) = 6 - brauer-chains: 1 non-brauer: 0 chains: (1 2 4 8 16 32 64)


;; a few extras
;; a few extras

Revision as of 08:07, 29 January 2016

Addition chains is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

An addition chain of length r for n is a sequence 1 = a(0) < a(1) < a(2) ... < a(r) = n , such as a(k) = a(i) + a(j) ( i < k and j < k , i may be = j) . Each member is the sum of two earlier members, not necessarily distincts.

A Brauer chain for n is an addition chain where a(k) = a(k-1) + a(j) with j < k. Each member uses the previous member as a summand.

We are interested in chains of minimal length L(n).

Task

For each n in {7,14,21,29,32,42,64} display the following : L(n), the count of Brauer chains of length L(n), an example of such a Brauer chain, the count of non-brauer chains of length L(n), an example of such a chain. (NB: counts may be 0 ).

Extra-credit: Same task for n in {47, 79, 191, 382 , 379, 12509}

References

  • OEIS sequences A079301, A079302. [1]
  • Richard K. Guy - Unsolved problems in Number Theory - C6 - Addition chains.

Example

  • minimal chain length l(19) = 6
  • brauer-chains(19) : count = 31 Ex: ( 1 2 3 4 8 11 19)
  • non-brauer-chains(19) : count = 2 Ex: ( 1 2 3 6 7 12 19)

EchoLisp

<lang scheme>

2^n

(define exp2 (build-vector 32 (lambda(i)(expt 2 i))))

counters and results

(define-values (*minlg* *counts* *chains* *calls*) '(0 null null 0))

(define (register-hit chain lg ) (define idx (if (brauer? chain lg) 0 1))

   (when (< lg *minlg*) 
       (set! *counts* (make-vector 2 0))
       (set! *chains* (make-vector 2 ""))
       (set! *minlg* lg))
   (vector+= *counts* idx 1)
   (vector-set! *chains* idx (vector->list chain)))

is chain a brauer chain ?

(define (brauer? chain lg)

   (for [(i (in-range 1 lg))]
       #:break (not (vector-search* (- [chain i] [chain (1- i)]) chain)) => #f
       #t))
       
all min chains to target n (brute force)

(define (chains n chain lg (a) (top) (tops null)) (++ *calls*) (set! top [chain lg])

   (cond 
   [(> lg *minlg*) #f] ;; too long
   [(= n top) (register-hit chain lg)]  ;; hit 
   [(< n top) #f] ;; too big
   [(and (< *minlg* 32) (< (* top [exp2 (- *minlg* lg)]) n)) #f] ;; too small
   [else
   (for*  ([i (in-range lg -1 -1)] [j (in-range lg (1- i) -1)])      
         (set! a (+ [chain i] [chain j]))
         #:continue (<= a top) ;; increasing sequence
         #:continue (memq a tops) ;; prevent duplicates
         (set! tops (cons a tops))
         (vector-push chain a)
         (chains n chain  (1+ lg))
         (vector-pop chain))]))
         
         

(define (task n)

   (set!-values (*minlg* *calls*) '(Infinity 0 ))
   (chains n (make-vector 1 1) 0)
   (printf "L(%d) = %d - brauer-chains: %d  non-brauer: %d  chains: %a %a " 
        n *minlg* [*counts* 0] [*counts* 1] [*chains* 0] [*chains* 1]))

</lang>

Output:
(for-each task {7 14 21 29 32 42 64})

L(7) = 4 - brauer-chains: 5 non-brauer: 0 chains: (1 2 3 4 7)  
L(14) = 5 - brauer-chains: 14 non-brauer: 0 chains: (1 2 3 4 7 14)  
L(21) = 6 - brauer-chains: 26 non-brauer: 3 chains: (1 2 3 4 7 14 21) (1 2 4 5 8 13 21) 
L(29) = 7 - brauer-chains: 114 non-brauer: 18 chains: (1 2 3 4 7 11 18 29) (1 2 3 6 9 11 18 29) 
L(32) = 5 - brauer-chains: 1 non-brauer: 0 chains: (1 2 4 8 16 32)  
L(42) = 7 - brauer-chains: 78 non-brauer: 6 chains: (1 2 3 4 7 14 21 42) (1 2 4 5 8 13 21 42) 
L(64) = 6 - brauer-chains: 1 non-brauer: 0 chains: (1 2 4 8 16 32 64) 

;; a few extras
(task 47)
L(47) = 8 - brauer-chains: 183 non-brauer: 37 chains: (1 2 3 4 7 10 20 27 47) (1 2 3 5 7 14 19 28 47) 
(task 79)
L(79) = 9 - brauer-chains: 492 non-brauer: 129 chains: (1 2 3 4 7 9 18 36 43 79) (1 2 3 5 7 12 24 31 48 79)