Column Prunning

0 views
Skip to first unread message

Justin John McCarty

unread,
Nov 5, 2008, 5:13:26 PM11/5/08
to ic...@googlegroups.com
All,

Rather then re-invent the wheel, has anyone created a function to column
prune if all elements in the column are the same value? ie. a group of
((1 2 3 5) (2 3 5 5) (9 8 6 5)) would become ((1 2 3) (2 3 5) (9 8 6))

If you do let me know.
Thanks,
Justin

dan brooks

unread,
Nov 5, 2008, 6:16:35 PM11/5/08
to ic...@googlegroups.com
here is a hack job of it...

(remove-if #'(lambda (x) (apply #'= x)) (transpose '(your data lists here))

Dan

dan brooks

unread,
Nov 5, 2008, 6:18:54 PM11/5/08
to ic...@googlegroups.com
sorry... i meant

(transpose (remove-if #'(lambda (x) (apply #'= x)) (transpose '(your data lists here)))


Dan

Justin John McCarty

unread,
Nov 5, 2008, 6:40:48 PM11/5/08
to ic...@googlegroups.com

Thanks for the attempt (i found the transpose myself), but either way it
does not work as i need. The number example provided was just a simple
circumstance. The true pruner would delete the column regardless of
variable type. An example would be to remove the 3rd column of the
segment data set (again disregard that fact that they are all numbers).

Justin

dan brooks

unread,
Nov 5, 2008, 6:41:55 PM11/5/08
to ic...@googlegroups.com
#'equal or make a case statement inside the lambda... ?

Dan

Justin John McCarty

unread,
Nov 5, 2008, 6:48:40 PM11/5/08
to ic...@googlegroups.com
Nope, equal only takes 2 arguments at max. Cudos on the quick reply though.

Tim Menzies

unread,
Nov 5, 2008, 7:12:37 PM11/5/08
to ic...@googlegroups.com
the xindex structure described on pages 123 on  http://iccle.googlecode.com/svn/trunk/share/pdf/iccle-848.pdf shows that we can auto-count the column frequencies. the case you want is when (= 1 (counted-n r)).

as to what you do after that.... that is all your fun!

t


On Wed, Nov 5, 2008 at 5:13 PM, Justin John McCarty <jmcc...@mix.wvu.edu> wrote:



--
timm, a/prof, csee, wvu, usa

Bill Vaughan  - "The tax collector must love poor people, he's creating so many of them."

dan brooks

unread,
Nov 5, 2008, 7:21:28 PM11/5/08
to ic...@googlegroups.com
If you just have some lists and its not in a table...
this does everything... i think

(defun samep (lst) 
(null (remove-if-not #'null (mapcar #'(lambda (x) (if (numberp x) (= x (car lst)) (string= (symbol-name x) (symbol-name (car lst))))) lst))))

there are much more elegant ways of doing it but again... this is a hack job

Dan

Tim Menzies

unread,
Nov 5, 2008, 7:57:03 PM11/5/08
to ic...@googlegroups.com
On Wed, Nov 5, 2008 at 7:21 PM, dan brooks <alloh...@gmail.com> wrote:
If you just have some lists and its not in a table...
this does everything... i think

(defun samep (lst) 
(null (remove-if-not #'null (mapcar #'(lambda (x) (if (numberp x) (= x (car lst)) (string= (symbol-name x) (symbol-name (car lst))))) lst))))

there are much more elegant ways of doing it but again... this is a hack job

Dan
;; i am in awe of dan's coding skills!
;; my version is MUCH longer than dan's

; first, i wrote something that returns "t" if everything in a list has the same value
 
(defun singletonp (list) ; top-level driver. initializes the goal variable for the worker
  (or (null list)
      (singletonp1 (first list) (rest list))))

(defun singletonp1 (goal list) ; the worker
  (or (null list)
      (and  (eql         goal (first list))
            (singletonp1 goal (rest list)))))

; second, i wrote those that turned the columns into rows so i can use my "singletonp" column

(defun transpose (x)
   (apply #'mapcar (cons #'list x)))

; third, i write something that glues it all together. note that there are two calls to transpose:
; once to turn columns to rows then once to turn it all backwards

(defun prune-singleton-columns (lists)
  (transpose
   (prune-singleton-columns1
    (transpose lists))))

; this one just runs over the lists and only adds to "out" if it is not a singletonp
(defun prune-singleton-columns1 (lists)
  (let (out)
    (dolist (list lists (reverse out))
      (unless (singletonp list)
        (push list out)))))
 
; fourth, i wrote a test case to see if i can reprorduce justin's goal

(defun testdata ()
  '((1 2 3 5) (2 3 5 5) (9 8 6 5)))

(defun test-prune-singleton-columns ()
  (prune-singleton-columns (testdata)))

; that's all. for an example on how to call this, see test-prune-singleton-columns

t
--
timm, a/prof, csee, wvu, usa

Chris Rock  - "You don't pay taxes - they take taxes."

dan brooks

unread,
Nov 5, 2008, 8:58:15 PM11/5/08
to ic...@googlegroups.com
I made it too hard... this one is better
(defun samep (lst) (null (remove-if-not #'null (mapcar #'(lambda (x) (equal x (car lst))) lst))))

the old version didn't do everything... this one can do things like cons pairs...

and I never answered the question so here it is

(transpose (remove-if #'(lambda (x) (samep x)) (transpose 'yourlisthere)))

Dan

Tim Menzies

unread,
Nov 5, 2008, 9:19:00 PM11/5/08
to ic...@googlegroups.com
On Wed, Nov 5, 2008 at 8:58 PM, dan brooks <alloh...@gmail.com> wrote:
I made it too hard... this one is better
(defun samep (lst) (null (remove-if-not #'null (mapcar #'(lambda (x) (equal x (car lst))) lst))))

i'm not 100% sold on the list traversal of mapcar continuing, even if the counter-example has been found. this version cuts out as soon as the different guy is found:

(defun samep (lst)
  (let ((x (first lst)))
    (dolist (one lst t)
      (unless (equal x one)
        (return-from samep nil)))))

t

 

--
timm, a/prof, csee, wvu, usa

Fulton J. Sheen  - "Hearing nuns' confessions is like being stoned to death with popcorn."
Reply all
Reply to author
Forward
0 new messages