Created
July 14, 2010 15:42
-
-
Save cametan001/475593 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ;; P11 (*) Modified run-length encoding. | |
| ;; Modify the result of problem P10 in such a way that if an element has no duplicates it is simply copied into the result list. Only elements with duplicates are transferred as (N E) lists. | |
| ;; Example: | |
| ;; * (encode-modified '(a a a a b c c a a d e e e e)) | |
| ;; ((4 A) B (2 C) (2 A) D (4 E)) | |
| (require srfi/1) | |
| (define (encode lst) | |
| (let loop ((lst lst) (acc '())) | |
| (if (null? lst) | |
| (reverse acc) | |
| (loop (strip lst) | |
| (cons | |
| (let ((head (car lst)) | |
| (len (length (picks lst)))) | |
| (if (= len 1) | |
| head | |
| `(,len ,head))) | |
| acc))))) | |
| (define-syntax define-encode-aux | |
| (syntax-rules () | |
| ((_ name proc) | |
| (define (name lst) | |
| (let ((head (car lst))) | |
| (proc (lambda (x) | |
| (eq? head x)) lst)))))) | |
| ;; Using a procedure, take-while, defined in SRFI-1 | |
| (define-encode-aux picks take-while) | |
| ;; Using a procedure, drop-while, defined in SRFI-1 | |
| (define-encode-aux strip drop-while) |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ;; P12 (**) Decode a run-length encoded list. | |
| ;; Given a run-length code list generated as specified in problem P11. Construct its uncompressed version. | |
| (define (decode lst) | |
| (let loop ((lst lst) (acc '())) | |
| (if (null? lst) | |
| (reverse acc) | |
| (let ((head (car lst))) | |
| (loop (cdr lst) (append | |
| (if (pair? head) | |
| (decode-aux head) | |
| `(,head)) acc)))))) | |
| (define (decode-aux lst) | |
| (let ((n (car lst)) (symb (cadr lst))) | |
| (let loop ((n n) (acc '())) | |
| (if (zero? n) | |
| acc | |
| (loop (- n 1) (cons symb acc)))))) |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ;; P13 (**) Run-length encoding of a list (direct solution). | |
| ;; Implement the so-called run-length encoding data compression method directly. I.e. don't explicitly create the sublists containing the duplicates, as in problem P09, but only count them. As in problem P11, simplify the result list by replacing the singleton lists (1 X) by X. | |
| ;; Example: | |
| ;; * (encode-direct '(a a a a b c c a a d e e e e)) | |
| ;; ((4 A) B (2 C) (2 A) D (4 E)) | |
| ;; Basd on the implementation of Paul Graham's ANSI Common Lisp | |
| (define (encode-direct x) | |
| (if (pair? x) | |
| (compress (car x) 1 (cdr x)) | |
| x)) | |
| (define (compress elt n lst) | |
| (let loop ((elt elt) (n n) (lst lst) (acc '())) | |
| (let ((cna (cons (n-elts elt n) acc))) | |
| (if (null? lst) | |
| (reverse cna) | |
| (let ((next (car lst)) | |
| (tail (cdr lst))) | |
| (if (eq? next elt) | |
| (loop elt (+ n 1) tail acc) | |
| (loop next 1 tail cna))))))) | |
| (define (n-elts elt n) | |
| (if (> n 1) | |
| `(,n ,elt) | |
| elt)) |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ;; P14 (*) Duplicate the elements of a list. | |
| ;; Example: | |
| ;; * (dupli '(a b c c d)) | |
| ;; (A A B B C C C C D D) | |
| (define (dupli lst) | |
| (let loop ((lst lst) (acc '())) | |
| (if (null? lst) | |
| (reverse acc) | |
| (let ((head (car lst))) | |
| (loop (cdr lst) | |
| (append `(,head ,head) acc)))))) |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ;; P15 (**) Replicate the elements of a list a given number of times. | |
| ;; Example: | |
| ;; * (repli '(a b c) 3) | |
| ;; (A A A B B B C C C) | |
| (define (repli lst int) | |
| (let loop ((lst lst) (i int) (acc '())) | |
| (cond ((null? lst) (reverse acc)) | |
| ((< i 1) (loop (cdr lst) int acc)) | |
| (else (loop lst (- i 1) (cons (car lst) acc)))))) |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ;; P16 (**) Drop every N'th element from a list. | |
| ;; Example: | |
| ;; * (drop '(a b c d e f g h i k) 3) | |
| ;; (A B D E G H K) | |
| (define (drop lst x) | |
| (let loop ((lst lst) (i 1) (acc '())) | |
| (let ((revacc (reverse acc))) | |
| (if (null? lst) | |
| revacc | |
| (let ((tail (cdr lst))) | |
| (cond ((< (length lst) x) | |
| (append revacc tail)) | |
| ((= i x) | |
| (loop tail 1 acc)) | |
| (else | |
| (loop tail (+ 1 i) (cons (car lst) acc))))))))) |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ;; P17 (*) Split a list into two parts; the length of the first part is given. | |
| ;; Do not use any predefined predicates. | |
| ;; Example: | |
| ;; * (split '(a b c d e f g h i k) 3) | |
| ;; ( (A B C) (D E F G H I K)) | |
| #lang racket | |
| (provide (all-defined-out)) | |
| (require srfi/1) | |
| (define (split pos lst) | |
| (take lst pos)) | |
| (define (split-after pos lst) | |
| (drop lst pos)) |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ;; P18 (**) Extract a slice from a list. | |
| ;; Given two indices, I and K, the slice is the list containing the elements between the I'th and K'th element of the original list (both limits included). Start counting the elements with 1. | |
| ;; Example: | |
| ;; * (slice '(a b c d e f g h i k) 3 7) | |
| ;; (C D E F G) | |
| (require srfi/1) | |
| (define (slice lst i k) | |
| (drop (take lst k) (- i 1))) |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ;; P19 (**) Rotate a list N places to the left. | |
| ;; Examples: | |
| ;; * (rotate '(a b c d e f g h) 3) | |
| ;; (D E F G H A B C) | |
| ;; * (rotate '(a b c d e f g h) -2) | |
| ;; (G H A B C D E F) | |
| ;; Hint: Use the predefined functions length and append, as well as the result of problem P17. | |
| (require "p17.ss") | |
| (define (rotate lst x) | |
| (define (proc arg) | |
| (if (negative? x) | |
| (reverse arg) | |
| arg)) | |
| (let ((ls (split (proc lst) (abs x)))) | |
| (let ((head (car ls)) (tail (cadr ls))) | |
| (proc (append tail head))))) |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ;; P20 (*) Remove the K'th element from a list. | |
| ;; Example: | |
| ;; * (remove-at '(a b c d) 2) | |
| ;; (A C D) | |
| #lang racket | |
| (provide remove-at) | |
| (define (remove-at lst pos) | |
| (let loop ((lst lst) (ini 1) (acc '())) | |
| (let ((tail (cdr lst))) | |
| (if (= pos ini) | |
| (append (reverse acc) tail) | |
| (loop tail (+ ini 1) (cons (car lst) acc)))))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment