Skip to content

Instantly share code, notes, and snippets.

@cametan001
Created July 14, 2010 15:42
Show Gist options
  • Select an option

  • Save cametan001/475593 to your computer and use it in GitHub Desktop.

Select an option

Save cametan001/475593 to your computer and use it in GitHub Desktop.
;; 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)
;; 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))))))
;; 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))
;; 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))))))
;; 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))))))
;; 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)))))))))
;; 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))
;; 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)))
;; 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)))))
;; 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