quarta-feira, 29 de julho de 2009

Fatiamento de seqüências em Scheme

Python oferece uma funcionalidade interessante para ser usadas com seqüências (string, listas e qualquer objeto com o método __getslice__, suponho). O fatiamento de Python admite índices negativos, omissão de índices e índices maiores que o tamanho da seqüência.

Exemplos:

>>> "abcdef"[3:6]
'def'
>>> [1, 2, 3, 4, 5][:3]
[1, 2, 3]
>>> [1,2,3,4,5][:-3]
[1, 2]
>>> [1,2,3,4,5][-3:]
[3, 4, 5]
>>> [1,2,3,4,5][-10:]
[1, 2, 3, 4, 5]


A seguir está uma implementação de algo parecido para Chicken, que funciona com listas, vetores, strings e permite a adição de fatiadores personalizados para o procedimento slice.

#!/usr/bin/csi -script

(use (srfi 1 13))

(define slice
(let ()
(define (positive? n) (> n 0))
(define (negative? n) (< n 0))
(define (both-positive? n m) (and n m (>= n 0) (>= m 0)))

(define (from/to from to len)
(cond
((and from (> from len)) ; [XXX:2]
#f)
((and (both-positive? from to) ; [1:2]
from to
(> to from)
(< to len))
(cons from to))
((and (both-positive? from to) ; [1:XXX]
from to
(> to from)
(>= to len))
(cons from len))
((and (both-positive? from to) ; [2:1]
from to
(> from to))
#f)
((and from ; [-1:]
(< from 0)
(not to))
(cons (if (>= (abs from) len)
0
(+ len from))
len))
((and (not from) ; [:-1]
to
(< to 0))
(cons 0
(if (>= (abs to) len)
len
(+ len to))))
((and from ; [1:]
(>= from 0)
(not to))
(cons from len))
((and from to ; [-2:-1]
(< from 0)
(< to 0)
(< to from))
#f)
((and from to ; [-1:-2]
(< from 0)
(< to 0))
(cons (if (>= (abs from) len)
0
(+ len from))
(if (>= (abs to) len)
len
(+ len to))))
(else #f)))

(define (generic-slicer obj from to ruler empty obj-slicer)
(let* ((len (ruler obj))
(from&to (from/to from to len))
(from (and from&to (car from&to)))
(to (and from&to (cdr from&to))))
(if (and from to)
(obj-slicer obj from to)
empty)))

(define (string-slice s from to)
(generic-slicer s from to string-length "" substring))

(define (list-slice l from to)
(generic-slicer l from to length '()
(lambda (l from to)
(take (drop l from) (- to from)))))

(define (vector-slice v from to)
(define (subvector vector start end)
(let ((sub (make-vector (- end start))))
(let loop ((i 0))
(if (< i (- end start))
(begin (vector-set! sub i (vector-ref vector (+ i start)))
(loop (+ i 1)))))
sub))
(generic-slicer v from to vector-length '#() subvector))


(let ((slicers
(list (lambda (obj)
(and (string? obj)
string-slice))
(lambda (obj)
(and (vector? obj)
vector-slice))
(lambda (obj)
(and (list? obj)
list-slice)))))
(lambda (obj #!optional from to)
(if (procedure? obj)
(set! slicers (cons obj slicers))
(let loop ((slicers slicers))
(if (null? slicers)
(error "No slicer for the given object.")
(let* ((slicer (car slicers))
(slice (slicer obj)))
(if slice
(slice obj from to)
(loop (cdr slicers)))))))))))


Abaixo está o arquivo de teste do código de fatiamento (usando a extensão test), o qual também serve como exemplo de uso.

#!/usr/bin/csi -script

(use test)

(load "slice.scm")

;;;
;;; Strings
;;;
(define s "1234567")

(display "s = ")
(pp s)
(test "" (slice s 0 0))
(test "" (slice s 1 0))
(test "1" (slice s 0 1))
(test "" (slice s 10 10))
(test "1234567" (slice s 0 10))
(test "" (slice s 10 0))

(test "1234567" (slice s 0))
(test "7" (slice s -1))
(test "" (slice s 10))
(test "1234567" (slice s -10))
(test "4567" (slice s -4))

(test "" (slice s -4 -4))
(test "45" (slice s -4 -2))
(test "" (slice s -4 -10))
(test "123" (slice s -10 -4))


;;;
;;; Lists
;;;
(define l '(1 2 3 4 5 6 7))

(newline)
(display "l = ")
(pp l)

(test '() (slice l 0 0))
(test '() (slice l 1 0))
(test '(1) (slice l 0 1))
(test '(2 3) (slice l 1 3))
(test '() (slice l 10 10))
(test '(1 2 3 4 5 6 7) (slice l 0 10))
(test '() (slice l 10 0))

(test '(1 2 3 4 5 6 7) (slice l 0))
(test '(7) (slice l -1))
(test '() (slice l 10))
(test '(1 2 3 4 5 6 7) (slice l -10))
(test '(4 5 6 7) (slice l -4))

(test '() (slice l -4 -4))
(test '(4 5) (slice l -4 -2))
(test '() (slice l -4 -10))
(test '(1 2 3) (slice l -10 -4))

;;;
;;; Vectors
;;;
(define v '#(1 2 3 4 5 6 7))

(newline)
(display "v = ")
(pp v)

(test '#() (slice v 0 0))
(test '#() (slice v 1 0))
(test '#(1) (slice v 0 1))
(test '#(2 3) (slice v 1 3))
(test '#() (slice v 10 10))
(test '#(1 2 3 4 5 6 7) (slice v 0 10))
(test '#() (slice v 10 0))

(test '#(1 2 3 4 5 6 7) (slice v 0))
(test '#(7) (slice v -1))
(test '#() (slice v 10))
(test '#(1 2 3 4 5 6 7) (slice v -10))
(test '#(4 5 6 7) (slice v -4))

(test '#() (slice v -4 -4))
(test '#(4 5) (slice v -4 -2))
(test '#() (slice v -4 -10))
(test '#(1 2 3) (slice v -10 -4))

;;;
;;; Custom object
;;;
(define-record custom-string text)

(define s (make-custom-string "custom string"))
(slice (lambda (obj)
(and (custom-string? obj)
(lambda (obj from to)
(handle-exceptions
exn
""
(substring (custom-string-text obj) from to))))))

(newline)
(display "s = ")
(pp s)

(test "" (slice s 0 0))
(test "" (slice s 1 0))
(test "c" (slice s 0 1))



A seguir está a saída da execução do programa de teste:

s = "1234567"
(slice s 0 0) .................................. [ PASS]
(slice s 1 0) .................................. [ PASS]
(slice s 0 1) .................................. [ PASS]
(slice s 10 10) ................................ [ PASS]
(slice s 0 10) ................................. [ PASS]
(slice s 10 0) ................................. [ PASS]
(slice s 0) .................................... [ PASS]
(slice s -1) ................................... [ PASS]
(slice s 10) ................................... [ PASS]
(slice s -10) .................................. [ PASS]
(slice s -4) ................................... [ PASS]
(slice s -4 -4) ................................ [ PASS]
(slice s -4 -2) ................................ [ PASS]
(slice s -4 -10) ............................... [ PASS]
(slice s -10 -4) ............................... [ PASS]

l = (1 2 3 4 5 6 7)
(slice l 0 0) .................................. [ PASS]
(slice l 1 0) .................................. [ PASS]
(slice l 0 1) .................................. [ PASS]
(slice l 1 3) .................................. [ PASS]
(slice l 10 10) ................................ [ PASS]
(slice l 0 10) ................................. [ PASS]
(slice l 10 0) ................................. [ PASS]
(slice l 0) .................................... [ PASS]
(slice l -1) ................................... [ PASS]
(slice l 10) ................................... [ PASS]
(slice l -10) .................................. [ PASS]
(slice l -4) ................................... [ PASS]
(slice l -4 -4) ................................ [ PASS]
(slice l -4 -2) ................................ [ PASS]
(slice l -4 -10) ............................... [ PASS]
(slice l -10 -4) ............................... [ PASS]

v = #(1 2 3 4 5 6 7)
(slice v 0 0) .................................. [ PASS]
(slice v 1 0) .................................. [ PASS]
(slice v 0 1) .................................. [ PASS]
(slice v 1 3) .................................. [ PASS]
(slice v 10 10) ................................ [ PASS]
(slice v 0 10) ................................. [ PASS]
(slice v 10 0) ................................. [ PASS]
(slice v 0) .................................... [ PASS]
(slice v -1) ................................... [ PASS]
(slice v 10) ................................... [ PASS]
(slice v -10) .................................. [ PASS]
(slice v -4) ................................... [ PASS]
(slice v -4 -4) ................................ [ PASS]
(slice v -4 -2) ................................ [ PASS]
(slice v -4 -10) ............................... [ PASS]
(slice v -10 -4) ............................... [ PASS]

s = #<custom-string>
(slice s 0 0) .................................. [ PASS]
(slice s 1 0) .................................. [ PASS]
(slice s 0 1) .................................. [ PASS]

Spam via telefone

Como se não bastasse a praga de spams que assola o mundo dos e-mails, há algum tempo venho recebendo propagandas não solicitadas da própria companhia telefônica (TIM) -- tanto através de SMS como, ultimamente, por ligações e mensagens de voz.

Hoje decidi ligar para a TIM para ver se conseguia me livrar desse transtorno. O atendente me disse que não é possível desativar esse "serviço" e sugeriu que eu mandasse um e-mail para a ouvidoria TIM, cujo endereço estaria disponível no site da empresa. Quando eu disse que não faria por medo de começar a receber spam da TIM por e-mail também, ele mesmo deu uma risada discreta, como se estivesse pensando "ele tem razão, é muita burrice fazer isso".