From: Jason
Subject: arbitrary base number counting
Date: 
Message-ID: <1141716614.233264.287240@j52g2000cwj.googlegroups.com>
Hi, all!

I'm working on an exercise to "rotate" an arbitrary dimension array 90
degrees, such that an array of (5 7 2) would become an array of (7 2
5). This is a variation of an exercise in Graham's book.

The data copy should be trivial. Given two arrays of X,Y,Z,...
dimensions, all I need to do is set up a while loop starting at indices
0,0,0... and continue until there are no more cells. :)

As a helper funtion, I have devised an arbitrary counting algorithm.
Given two same-sized lists of integers, one representing the
"to-matrix" current cell, and the other representing the "from-matrix"
maximum x/y/z/etc... dimension value, I  can simply count.

For example, given the input of (0 0) and the maximum values of (6 4) I
can count like this:

(0 0)
(1 0)
(2 0)
(3 0)
(4 0)
(5 0)
(0 1)
(1 1)
(2 1)
(3 1)
(4 1)
(5 1)
(0 2)
(1 2)
(2 2)
(3 2)
(4 2)
(5 2)
(0 3)
(1 3)
(2 3)
(3 3)
(4 3)
(5 3)

Here's the code. I'd appreciate recommentdations on how to optimize
this. Thanks!

-Jason

;;;;;;;;; Code follows

(defun increment-number-list-by-1 (num max add)
    (unless (or (null num) (null max))
      (when (and (listp num) (listp max))
	(unless (not (= (length num) (length max)))
	  (let ((c (car num)) (m (car max)))
	    (if (= add 1)
		(setq c (+ c 1)))
	    (if (= c m)
		(progn
		  (setq c 0)
		  (setq add 1))
	      (setq add 0))
	    (append (list c)
		    (increment-number-list-by-1 (cdr num) (cdr max) add))))
	)))

(defun ok-to-continue (lst)
  (not (and (zerop (car lst))
       (zerop (car (cdr lst))))))

(progn
  (setq lst '(0 0))
  (setq max '(6 4))
  (print lst)
  (setq lst (increment-number-list-by-1 lst max 1))
  (while (ok-to-continue lst)
    (print lst)
    (setq lst (increment-number-list-by-1 lst max 1))))

From: Jason
Subject: Re: arbitrary base number counting
Date: 
Message-ID: <1141717532.281367.5190@u72g2000cwu.googlegroups.com>
Jason wrote:

> (defun ok-to-continue (lst)
>   (not (and (zerop (car lst))
>        (zerop (car (cdr lst))))))

I noticed an error in this function. Here's the fix... :)

(defun ok-to-continue (lst)
  (let ((ok nil))
    (dolist (x lst)
      (if (> x 0)
	  (setq ok t)))
    ok))
From: Jim Smith
Subject: Re: arbitrary base number counting
Date: 
Message-ID: <x6hd6atuf4.fsf@gmail.com>
"Jason" <·······@gmail.com> writes:

> Jason wrote:
>
>> (defun ok-to-continue (lst)
>>   (not (and (zerop (car lst))
>>        (zerop (car (cdr lst))))))
>
> I noticed an error in this function. Here's the fix... :)
>
> (defun ok-to-continue (lst)
>   (let ((ok nil))
>     (dolist (x lst)
>       (if (> x 0)
> 	  (setq ok t)))
>     ok))

(defun ok-to-continue (lst)
  (not (every #'zerop lst)))
From: Zach Beane
Subject: Re: arbitrary base number counting
Date: 
Message-ID: <m3psky4d82.fsf@unnamed.xach.com>
Jim Smith <···········@gmail.com> writes:

> (defun ok-to-continue (lst)
>   (not (every #'zerop lst)))

   (defun ok-to-continue (list)
     (any #'plusp list))

Zach
From: Anon
Subject: Re: arbitrary base number counting
Date: 
Message-ID: <_aadnV6YTfEg9JLZRVn-qQ@comcast.com>
Jason wrote:
> Hi, all!
> 
> I'm working on an exercise to "rotate" an arbitrary dimension array 90
> degrees, such that an array of (5 7 2) would become an array of (7 2
> 5). This is a variation of an exercise in Graham's book.
> 
> The data copy should be trivial. Given two arrays of X,Y,Z,...
> dimensions, all I need to do is set up a while loop starting at indices
> 0,0,0... and continue until there are no more cells. :)
> 
> As a helper funtion, I have devised an arbitrary counting algorithm.
> Given two same-sized lists of integers, one representing the
> "to-matrix" current cell, and the other representing the "from-matrix"
> maximum x/y/z/etc... dimension value, I  can simply count.
> 
> For example, given the input of (0 0) and the maximum values of (6 4) I
> can count like this:
> 
> (0 0)
> (1 0)
> (2 0)
> (3 0)
> (4 0)
> (5 0)
> (0 1)
> (1 1)
> (2 1)
> (3 1)
> (4 1)
> (5 1)
> (0 2)
> (1 2)
> (2 2)
> (3 2)
> (4 2)
> (5 2)
> (0 3)
> (1 3)
> (2 3)
> (3 3)
> (4 3)
> (5 3)
> 
> Here's the code. I'd appreciate recommentdations on how to optimize
> this. Thanks!
> 
> -Jason
> 
> ;;;;;;;;; Code follows
> 
> (defun increment-number-list-by-1 (num max add)
>     (unless (or (null num) (null max))
>       (when (and (listp num) (listp max))
> 	(unless (not (= (length num) (length max)))
> 	  (let ((c (car num)) (m (car max)))
> 	    (if (= add 1)
> 		(setq c (+ c 1)))
> 	    (if (= c m)
> 		(progn
> 		  (setq c 0)
> 		  (setq add 1))
> 	      (setq add 0))
> 	    (append (list c)
> 		    (increment-number-list-by-1 (cdr num) (cdr max) add))))
> 	)))
> 
> (defun ok-to-continue (lst)
>   (not (and (zerop (car lst))
>        (zerop (car (cdr lst))))))
> 
> (progn
>   (setq lst '(0 0))
>   (setq max '(6 4))
>   (print lst)
>   (setq lst (increment-number-list-by-1 lst max 1))
>   (while (ok-to-continue lst)
>     (print lst)
>     (setq lst (increment-number-list-by-1 lst max 1))))
> 

This is my first attempt at this one.
It generates a list of lists.


(defun make-coord (x y) (list x y))
(defun coord-x (p) (car p))
(defun coord-y (p) (cadr p))

(defun coord-sub1 (p)
   (make-coord (- (coord-x p) 1) (- (coord-y p) 1)))

(defun coord-equal (a b)
   (and (= (coord-x a) (coord-x b))
        (= (coord-y a) (coord-y b))))

(defun coord-stepper (start end)
   #'(lambda (p)
       (let ((x (if (< (1+ (coord-x p)) (coord-x end))
		   (1+ (coord-x p))
		   (coord-x start)))
	    (y (if (< (1+ (coord-x p)) (coord-x end))
		   (coord-y p)
		   (1+ (coord-y p)))))
	(make-coord x y))))

(defun gen-coords (start end)
   (let ((stepper (coord-stepper start end))
	(end (coord-sub1 end)))
     (labels ((gen-list (s e)
	       (if (coord-equal s e)
		   (cons e nil)
		   (cons s
			 (gen-list (funcall stepper s) e)))))
       (gen-list start end))))


(defparameter start (make-coord 0 0))
(defparameter end (make-coord 6 4))
(pprint (gen-coords start end))
From: Frank Buss
Subject: Re: arbitrary base number counting
Date: 
Message-ID: <1aifue1ul2pcc$.1s3ya7q19hzw8$.dlg@40tude.net>
Jason wrote:

> As a helper funtion, I have devised an arbitrary counting algorithm.
> Given two same-sized lists of integers, one representing the
> "to-matrix" current cell, and the other representing the "from-matrix"
> maximum x/y/z/etc... dimension value, I  can simply count.

I'm not sure, if you can use this in your algorithm, but this is a
variation of my map-combinations function from the poker thread in this
newsgroup:

(defun map-counts (max fun &optional (number '()))
  (if (null max)
      (funcall fun number)
    (destructuring-bind (max-digit . rest) max
      (loop for digit from 0 below max-digit do
            (push digit number)
            (map-counts rest fun number)
            (pop number)))))

You can pass a function to the function:

(defun print-number (number)
  (format t "~a~%" number))

(map-counts '(6 4) #'number)

BTW: another nice application for higher order functions:
http://www.frank-buss.de/lisp/functional.html

-- 
Frank Buss, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
From: Frank Buss
Subject: Re: arbitrary base number counting
Date: 
Message-ID: <nlxi18m1nu89$.1o4hnlomdmlb5.dlg@40tude.net>
Frank Buss wrote:

> I'm not sure, if you can use this in your algorithm

it can be used for rotating arrays:

(defun roll-list (list)
  (destructuring-bind (first . rest) list
    (append rest (list first))))

(defun rotate-90 (array)
  (let* ((dimensions (array-dimensions array))
         (new-array (make-array (roll-list dimensions))))
    (map-counts (reverse dimensions)
                #'(lambda (index)
                    (setf (apply #'aref (cons new-array (roll-list index)))
                          (apply #'aref (cons array index)))))
    new-array))

CL-USER > (rotate-90 #2a((1 2)(3 4)))
#2A((1 3) (2 4))

CL-USER > (rotate-90 #2a((1 2 3)(4 5 6)))
#2A((1 4) (2 5) (3 6))

CL-USER > (defparameter a #2a((1 2 3)(4 5 6)))
A

CL-USER > (dotimes (i 4) (setf a (rotate-90 a)))
NIL

CL-USER > a
#2A((1 2 3) (4 5 6))

CL-USER > (rotate-90 #3a(((1 2 3)(4 5 6))((7 8 9)(10 11 12))))
#3A(((1 7) (2 8) (3 9)) ((4 10) (5 11) (6 12)))

-- 
Frank Buss, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de