scheme6.rkt 1.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172
  1. #lang racket
  2. (define (sublists lst k)
  3. (let ((curr lst)
  4. (size (length lst)))
  5. (lambda ()
  6. (if (< size k)
  7. 'end
  8. (begin
  9. (let ((v (take curr k)))
  10. (set! size (- size 1))
  11. (set! curr (cdr curr))
  12. v))))))
  13. (define (checklist lst factors)
  14. (let* ((k (length (car factors)))
  15. (iter (sublists lst k)))
  16. (foldl
  17. (lambda (x r)
  18. (let ((curr (iter)))
  19. (if (member curr (cons 'end factors))
  20. r
  21. (cons curr r))))
  22. '()
  23. lst)))
  24. (checklist '(b b a a b b b c) '((a b) (b a) (b b)))
  25. (define (test lst)
  26. (foldl
  27. (λ (r x)
  28. (cons x r))
  29. 1
  30. lst))
  31. (test '(2 3))
  32. (define (co-sublist lst i j)
  33. (let loop ((p 0)
  34. (res '())
  35. (rem-lst lst))
  36. (cond
  37. ((null? rem-lst)
  38. res)
  39. ((or (< p i) (> p j))
  40. (loop (+ p 1)
  41. (append res (list (car rem-lst)))
  42. (cdr rem-lst)))
  43. (else
  44. (loop (+ p 1)
  45. res
  46. (cdr rem-lst))))))
  47. (define -> '->)
  48. (define <- '<-)
  49. (define (subl . args)
  50. (let loop ((state #f)
  51. (res '())
  52. (rem-lst args))
  53. (cond
  54. ((null? rem-lst)
  55. res)
  56. ((eq? (car rem-lst) '<-)
  57. (loop #f res (cdr rem-lst)))
  58. ((eq? (car rem-lst) '->)
  59. (loop #t res (cdr rem-lst)))
  60. (state
  61. (loop state (append res (list (car rem-lst))) (cdr rem-lst)))
  62. ((not state)
  63. (loop state res (cdr rem-lst))))))