Better (from the Wikipedia article), no recursion so probably faster
and much cleaner code:

(de permutation (N Lst)
   (for (J 2 (>= (length Lst) J) (inc J))
      (setq N (/ N (- J 1)))
      (setq Lst (switch Lst (inc (% N J)) J))))

(de permutate (Lst)
   (let Rslt (list)
      (for (N 1 (>= (fac (length Lst)) N) (inc N))
         (push Rslt (permutation N Lst)))
      (uniq (car Rslt))))

/Henrik


On Thu, Dec 25, 2008 at 10:33 PM, Henrik Sarvell <hsarv...@gmail.com> wrote:
> I just realized that it doesn't work properly with a longer list
> length than 3, back to the drawing board.
>
> /Henrik
>
> On Thu, Dec 25, 2008 at 7:41 PM, Henrik Sarvell <hsarv...@gmail.com> wrote:
>> Hello everyone, I couldn't find anything already created to this
>> effect so I sat down and did this, I even wrote a little about it
>> here: 
>> http://www.prodevtips.com/2008/12/25/factorials-permutations-and-recursion-in-pico-lisp/
>>
>> (de fac (Num)
>>
>>   (let Res 1
>>
>>      (for (N 1 (>= Num N) (inc N))
>>
>>         (setq Res (* Res N)))))
>>
>>
>>
>> (de switch (Lst P1 P2)
>>
>>  (let (V1 (get Lst P1) V2 (get Lst P2))
>>
>>      (place P1 (place P2 Lst V1) V2)))
>>
>>
>>
>> (de permutate (Lst)
>>
>>   (let (Result (list) Count 1 Start 1)
>>
>>      (recur (Lst Start Result Count)
>>
>>         (when (>= (fac (length Lst)) Count)
>>
>>            (push Result Lst)
>>
>>            (when (= Start (length Lst)) (setq Start 1))
>>
>>            (recurse
>>
>>               (switch Lst Start (inc Start))
>>
>>               (inc Start)
>>
>>               Result
>>
>>               (inc Count)))
>>
>>         (car Result))))
>>
>>
>>
>> (permutate '(1 2 3))
>>
>> I'm sure this could be done more efficiently and with less code,
>> anyone has any suggestions?
>>
>> Anyway when this stuff - and I'm sure there is more like it - has been
>> sanitized/optimized maybe it could constitute some kind of extended
>> library, lib2.l maybe?
>>
>> Cheers and happy new year!
>>
>> /Henrik
>>
>
-- 
UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe

Reply via email to