Pages: [1]   Go Down
Print
Author Topic: MergeSort in scheme  (Read 2006 times)
0 Members e 1 Utente non registrato stanno visualizzando questa discussione.
shiny
Forumista
***
Offline Offline

Posts: 810



WWW
« on: 19-03-2011, 02:35:42 »

questo codice implementa il mergesort bottom-up invece che il classico top-down: da liste unitarie si procede fondendole a 2 a 2 in modo ordinato fino a che non se ne ottiene una sola che alla fine risulta ordinata.
Buona lettura    
Code:
;; split function return a list of lists where each internal list contains one element of the input list
(define (split ls)
  ( if (null? ls)
       (list empty)
       (cons (list (car ls)) (split (cdr ls)))))

;; merge function return a ordered list which contains all the elements of the input lists
(define (merge ls1 ls2 prec?)
  (cond
    ((null? ls1) ls2)
    ((null? ls2) ls1)
    ((prec? (car ls1) (car ls2)) (cons (car ls1) (merge (cdr ls1) ls2 prec?)))
    (else (cons (car ls2) (merge ls1 (cdr ls2) prec?)))))

;; mergesort function sorts the list of lists using the merge sort algorithm
(define (mergesort lsls prec?)
  (cond
    ((or (null? lsls)(null? (cdr lsls))) lsls)
    (else (mergesort (cons (merge (car lsls)(cadr lsls) prec?) (mergesort (cddr lsls) prec?)) prec?))) )


;; mergesortlauncher function launches the merge sort algorithm
(define (mergesortlauncher ls)
  (car (mergesort (split ls) <=)))



;; Test
(define tosort (list 13 40 31 11 34 16 18 62 38 14 51 72 9))
(mergesortlauncher tosort)
« Last Edit: 19-03-2011, 03:18:59 by shiny » Logged
Franco Barbanera
Moderator
Forumista Eroico
*****
Offline Offline

Posts: 3.079



WWW
« Reply #1 on: 19-03-2011, 15:11:33 »

Fai anche l'altra versione.

Questo programma lo vedo poco ricorsivo.

FB
Logged
shiny
Forumista
***
Offline Offline

Posts: 810



WWW
« Reply #2 on: 20-03-2011, 20:47:20 »

Questa e' la versione top-down del mergesort pero' mi sa che la funzione splitintwo essendo un adattamento della partition del quick, soffre dello stesso problema della sorella, oltre al fatto che divide in due l'array con da un lato gli elementi di posizione dispari e dall'altro quelli con posizione pari... appena capisco come funziona versione ricorsiva prof della partition vedo di creare una versione dello splitintwo inerentemente ricorsiva.
Code:
(define (merge ls1 ls2 prec?)
  (cond
    ((null? ls1) ls2)
    ((null? ls2) ls1)
    ((prec? (car ls1) (car ls2)) (cons (car ls1) (merge (cdr ls1) ls2 prec?)))
    (else (cons (car ls2) (merge ls1 (cdr ls2) prec?)))))

(define (splitintwo ls)
  (letrec ([splitrec (lambda (ls p1 p2)
                      (cond
                        [(null? ls)
                         (list p1 p2)]
                        [(null? (cdr ls))
                         (list (cons (car ls) p1) p2)]
                        [else
                         (splitrec (cddr ls) (cons (car ls) p1) (cons (cadr ls) p2))]))])
    (splitrec ls empty empty)))

(define (mergesortnumber ls prec?)
  (let ([parts (splitintwo ls)])
    (if (or (null? ls) (null? (cdr ls)))
        ls
        (merge (mergesortnumber (cadr parts) prec?) (mergesortnumber (car parts) prec?) prec?) )))

(define tosort (list 13 40 31 11 34 16 18 62 38 14 51 72 9 57))
(define p <=)
(mergesortnumber tosort p)
« Last Edit: 20-03-2011, 20:49:32 by shiny » Logged
shiny
Forumista
***
Offline Offline

Posts: 810



WWW
« Reply #3 on: 20-03-2011, 22:06:48 »

aggiungo una versione di splitintwo che divide in 2 la lista senza usare liste di appoggio e senza il problema di sfasciare l'ordine prefissato degli elementi della lista.
Code:
(define (splitintwo2 ls)
  (letrec ([splitrec (lambda (ls)
                      (cond
                        [(null? (cdr ls))
                         ls]
                        [(>= (length (car ls)) (length (cdr ls)))
                         (list (reverse (car ls)) (cdr ls)) ]
                        [else
                         (splitrec (cons (cons (cadr ls)(car ls)) (cddr ls)))]))])
    (splitrec (cons empty ls))))

« Last Edit: 20-03-2011, 22:14:27 by shiny » Logged
Franco Barbanera
Moderator
Forumista Eroico
*****
Offline Offline

Posts: 3.079



WWW
« Reply #4 on: 21-03-2011, 10:12:17 »

E' iterativa,

Ma in questo caso non si puo' fare altrimenti.

FB

Logged
shiny
Forumista
***
Offline Offline

Posts: 810



WWW
« Reply #5 on: 21-03-2011, 10:18:19 »

Lo immaginavo perché alla fine riempie la lista interna proprio come si farebbe con un ciclo ma l'unica versione che sono riuscito a fare sulla base della sua partition era quella che metteva gli elementi dispari da un lato e i pari dall'altro ^^
Logged
shiny
Forumista
***
Offline Offline

Posts: 810



WWW
« Reply #6 on: 21-03-2011, 15:49:51 »

eccovi il codice delle evoluzioni della funzioni spitintwo 
Code:
;; prima versione con ricorsione di coda che posiziona gli elementi dispari nella prima lista e quelli dispari nella seconda
(define (splitintwo ls)
  (letrec ([splitrec (lambda (ls p1 p2)
                      (cond
                        [(null? ls)
                         (list p1 p2)]
                        [(null? (cdr ls))
                         (list (cons (car ls) p1) p2)]
                        [else
                         (splitrec (cddr ls) (cons (car ls) p1) (cons (cadr ls) p2))]))])
    (splitrec ls empty empty)))

;; seconda versione con ricorsione di coda che mantiene l'ordine
(define (splitintwo2 ls)
  (letrec ([splitrec (lambda (ls)
                      (cond
                        [(null? (cdr ls))
                         ls]
                        [(>= (length (car ls)) (length (cdr ls)))
                         (list (reverse (car ls)) (cdr ls)) ]
                        [else
                         (splitrec (cons (cons (cadr ls)(car ls)) (cddr ls)))]))])
    (splitrec (cons empty ls))))

;; versione puramente ricorsiva della splitintwo
(define (splitintwo3 ls)
  (if (null? ls)
      (list empty empty)
      (if (null? (cdr ls))
          (let ([lsls (splitintwo3 (cdr ls))])
            (list (cons (car ls) (car lsls)) empty))
          (let ([lsls (splitintwo3 (cddr ls))])
            (list (cons (car ls) (car lsls)) (cons (cadr ls)(cadr lsls)))))))

;; versione puramente ricorsiva della splitintwo2
(define (splitintwo4 ls)
  (if (null? ls)
      (list empty empty)
      (if (null? (cdr ls))
          (let ([lsls (splitintwo4 (cdr ls))])
            (list (cons (car ls) (car lsls)) empty))
          (let ([lsls (splitintwo4 (mlast (cdr ls)))])
            (list (cons (car ls) (car lsls)) (append (cadr lsls) (list (last ls))))))))
 
;; funzioni di supporto per la splitintwo4 
(define (mlast ls)
  (if (null? (cdr ls))
      empty
      (cons (car ls) (mlast (cdr ls)))))
(define (last ls)
  (if (null? (cdr ls))
      (car ls)
      (last (cdr ls))))

;; tests
;; 12 elementi
(define tosort (list 13 40 31 11 34 16 18 62 38 14 51 72 9 57))
(splitintwo tosort)
(splitintwo3 tosort)
(splitintwo2 tosort)
(splitintwo4 tosort)

;; 11 elementi
(define tosort (list 13 40 31 11 34 16 18 62 38 14 51 72 9))
(splitintwo tosort2)
(splitintwo3 tosort2)
(splitintwo2 tosort2)
(splitintwo4 tosort2)
« Last Edit: 21-03-2011, 18:46:38 by shiny » Logged
crash
Apprendista Forumista
**
Offline Offline

Posts: 238


« Reply #7 on: 21-03-2011, 20:23:28 »

cosa fa la funzione mlast e last?
Logged
shiny
Forumista
***
Offline Offline

Posts: 810



WWW
« Reply #8 on: 21-03-2011, 20:34:20 »

last ritorna l'ultimo elemento di una lista mentre mlast ritorna la lista priva del suo ultimo elemento (l'equivalente di car e cdr). Mi sembra che qualche collega abbia detto che siano gia' implementate, ma siccome mi seccavo a cercare ho tagliato la testa al toro e me le sono scritte io (in meno di 30 secondi xD)
« Last Edit: 22-03-2011, 00:29:35 by shiny » Logged
Pages: [1]   Go Up
Print
Jump to: