Maximum Product Sublist

[cameyo]

Maximum Product Sublist

Given a list that contains both positive and negative integers, find the product of the maximum product sublist.

Code Select Expand

(define (maxProd lst)
  (local (n maxprod pos neg)
    (setq n (length lst))
    (setq pos (array n '(0)))
    (setq neg (array n '(0)))
    (setq (pos 0) (lst 0)) ; pos[i] contains the positive product up to lst[i]
    (setq (neg 0) (lst 0)) ; neg[i] contains the negative product up to lst[i]
    (setq maxprod (lst 0))
    (for (i 0 (- n 1))
      ; the maximum of the three values
      (setq (pos i) (max (max (* (pos (- i 1)) (lst i)) (* (neg (- i 1)) (lst i))) (lst i)))
      ; the minimum of the three values
      (setq (neg i) (min (min (* (pos (- i 1)) (lst i)) (* (neg (- i 1)) (lst i))) (lst i)))
      (setq maxprod (max maxprod (pos i)))
    )
    maxprod
  )
)

(setq lst '(6 -3 -10 0 2))
(maxProd lst)
;-> 180
Sublist: (6 -3 -10)

(setq lst '(-1 -3 -10 0 60))
(maxProd lst)
;-> 60
Sublist: (60)

(setq lst '(-2 -3 0 -2 -40))
(maxProd lst)
;-> 80
Sublist: (-2 -40)

(setq lst '(-1 -2 -3))
(maxProd lst)
;-> 6

(setq lst '(0 -1))
(maxProd lst)
;-> 0

(setq lst '(0 0 0 0))
(maxProd lst)
;-> 0

Please, post your version :-)

cameyo



p.s. The "Maximum Sum sublist" problem is solved with the Kadane algorithm

[rickyboy]

Here's my version.

Code Select Expand

(define (maxProd lst)
  ;; lst must contain integers; note use of integer op `*`.
  (apply max
         (map (fn (prods) (apply * prods))
              (remove '() (powerset lst)))))
You'll need these functions.

Code Select Expand

(define (mappend) (apply append (apply map (args))))
(define (powerset s)
  (if s
      (mappend (fn (x) (list (cons (s 0) x) x))
               (powerset (1 s)))
      '(())))
However, my code gets different answers for your inputs, so maybe I don't understand the problem statement.

Code Select Expand

> (maxProd '(6 -3 -10 0 2))
360   ; i.e., (* 6 -3 -10 2)
> (maxProd '(-1 -3 -10 0 60))
1800   ; i.e., (* -3 -10 60)
> (maxProd '(-2 -3 0 -2 -40))
480   ; i.e., (* -2 -3 -2 -40)
> (maxProd '(-1 -2 -3))
6
> (maxProd '(0 -1))
0
> (maxProd '(0 0 0 0))
0

[cameyo]

Hi rickyboy,

the sublist must contains only contiguous elements.

But your functions are useful anyway :-)

[rickyboy]

Hi rickyboy

Hi cameyo! :)

the sublist must contains only contiguous elements.

But your functions are useful anyway :-)

Ah, ok!  Then my updated maxProd function is still very similar to my original.

Code Select Expand

(define (maxProd lst)
  ;; lst must contain integers; note use of integer op `*`.
  (apply max
         (map (fn (prods) (apply * prods))
              (sublists lst))))
The difference is that the expression (remove '() (powerset lst)) is now replaced by the expression (sublists lst), which generates a list of the sublists (contiguous) of lst.



And this indeed yields the same results as your function does.

Code Select Expand

> (maxProd '(6 -3 -10 0 2))
180
> (maxProd '(-1 -3 -10 0 60))
60
> (maxProd '(-2 -3 0 -2 -40))
80
> (maxProd '(-1 -2 -3))
6
> (maxProd '(0 -1))
0
> (maxProd '(0 0 0 0))
0
I leave the definition of sublists is a reader exercise.  This is how I get to "leave fun on the table," as Ralph did earlier. :)

[rrq]

Indeed, sublist was a quite fun exercise. Thanks :) I ended up with the following as my "best" candidate:

Code Select Expand

(define (sublists s (i 0) (n (inc (length s))) (N n))
  (collect (if (> n 2) (i (dec n) s) (> (setf n (dec N)) 2) ((inc i) (dec n) s)))) That one performed best for me, and (more or less incidentally) it lets you choose a later start point and a max length of the sub lists.



Implicit slice seemed to be ~10% faster than explicit slice, and the iterative collation was ~5 times faster than the recursive variant. I didn't try any imperative "push within double loop" variant as I would expect that to be even slower.

[cameyo]

Hi rickyboy and ralph.ronnquist,

you're very friendly and competent.

And yes, newLISP is fun.

Have a nice day.

cameyo