far_kurt
far_kurt

Reputation: 39

How to make pairs from a numeric list based on cardinality?

I have a list '(1 2 1 1 4 5) and want output list as '((1 3)(2 1)(4 1)(5 1)). I have written a small code but I am stuck with how to calculate the cardinality for each number and then put it as pair in list. Can anyone please look at my code and give some ideas?

(define set2bags
  (lambda (randlist)
    (cond ((null? randlist) '())
          (else
           (sort randlist)
           (makepairs randlist)))))

(define makepairs
  (lambda (inlist)
    (let ((x 0)) ((newlist '()))
      (cond ((zero? (car inlist)) '())
            (else
             (eq? (car inlist)(car (cdr inlist))) 
             (+ x 1) 
             (makepairs (cdr inlist)) 
             (append newlist (cons (car inlist) x)))))))

Upvotes: 2

Views: 544

Answers (2)

WorBlux
WorBlux

Reputation: 1413

Your code is fairly hard to read without proper formating. I notice a two branch cond, which is easier to read as an if.

In your else clause of set2bags, you call (sort randlist) but leave it as is. You actually want to use this in the next s-expression (makepairs (sort randlist))

So far a pretty good idea.

Now in makepairs you should have better abstraction, say let variables like-first and unlike-first. If the inlist is null, then the function should be the null list, else it's the pair with the car being the list of the car of like-first and the length of like-first and the cdr being the result of calling makepairs on the unlike-first list

(define (makepairs inlist)
 (let ((like-first (filter (lambda (x) (equal? x (car inlist)) inlist))
       (unlike-first (filter (lambda (x) (not (equal? x (car inlist))) inlist)))
  (if (null? inlist)
      '()
       (cons (list (car inlist) (length like-first)) (makepairs unlike-first)))))

more effecient version

(define (makepairs inlist)
 (if (null? inlist)
     '()
     (let loop ((firsts (list (car inlist))) 
               (but-firsts (cdr inlist)))
       (if (or (null? but-firsts) 
               (not (equal? (car firsts) (car but-firsts))))
           (cons (list (car firsts) (length firsts)) 
                 (makepairs but-firsts))
           (loop (cons (car but-firsts) firsts) (cdr but-firsts))))))

]=> (makepairs (list 1 1 1 2 4 5))

;Value 17: ((1 3) (2 1) (4 1) (5 1))

If you have your own implementation of sort, say a mergesort you could write this right into the merge part for the best effeciency.

(define (set2bags lst)
 (mergesort2bags lst <))

(define (mergesort2bags lst pred)
 (let* ((halves (divide-evenly lst))
        (first-half (car halves))
        (other-half (cadr halves)))
 (cond  ((null? lst) '())
        ((null? (cdr lst)) (list (list (car lst) 1)))
        (else
         (merge-bags 
             (mergesort2bags first-half pred)
             (mergesort2bags other-half pred)
             pred)))))

(define (divide-evenly lst)
 (let loop
  ((to-go lst)
   (L1 '())
   (l2 '()))
  (if (null? to-go)
      (list L1 L2)
      (loop (cdr to-go) (cons (car to-go) L2) L1))))

(define (merge-bags L1 L2 pred)
 (cond ((null? L1) L2)
       ((null? L2) L1)
       ((pred (caar L1) (caar L2))  
        (cons (car L1) (merge-bags (cdr L1) L2 pred)))
       ((equal? (caar L1) (caar L2))
        (cons (list (caar L1) (+ (cadar L1) (cadar L2))) 
              (merge-bags (cdr L1) (cdr L2) pred)))
       (else  (cons (car L2) (merge-bags L1 (cdr L2) pred)))))

(mergesort2bags (list 1 2 1 1 4 5) <)

;Value 46: ((1 3) (2 1) (4 1) (5 1))

I'm thinking for very large datasets with a lot of repetition this method would pay off.

Upvotes: 0

&#211;scar L&#243;pez
&#211;scar L&#243;pez

Reputation: 236004

Your current solution is incorrect - it doesn't even compile. Let's start again from scratch, using a named let for traversing the input list:

(define set2bags
  (lambda (randlist)
    (cond ((null? randlist) '())
          (else (makepairs (sort randlist >))))))

(define makepairs
  (lambda (inlist)
    (let loop ((lst inlist)
               (prv (car inlist))
               (num 0)
               (acc '()))
      (cond ((null? lst)
             (cons (list prv num) acc))
            ((= (car lst) prv)
             (loop (cdr lst) prv (add1 num) acc))
            (else
             (loop (cdr lst) (car lst) 1 (cons (list prv num) acc)))))))

Now it works as expected:

(set2bags '(1 2 1 1 4 5))
=> '((1 3) (2 1) (4 1) (5 1))

The trick is keeping a counter for the cardinality (I called it num), and incrementing it as long as the same previous element (I named it prv) equals the current element. Whenever we find a different element, we add a new pair to the output list (called acc) and reset the previous element and the counter.

Upvotes: 2

Related Questions