SHARE
TWEET

Untitled

a guest Nov 13th, 2019 102 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. (define (read-words)
  2.   (define (f words word c)
  3.       (cond ((and (eof-object? c) (not (null? words))) (reverse words))
  4.             ((and (eof-object? c) (not (null? word))) (f (cons (list->string (reverse word)) words) '() (read-char)))
  5.             ((eof-object? c) (reverse words))
  6.             ((and (or (equal? c #\newline) (equal? c #\tab) (equal? c #\space)) (null? word)) (f words word (read-char)))
  7.             ((or (equal? c #\newline) (equal? c #\tab) (equal? c #\space)) (f (cons (list->string (reverse word)) words) '() (read-char)))
  8.             (else (f words (cons c word) (read-char)))))
  9.   (f '() '() (read-char)))
  10.  
  11.  
  12.  
  13. (use-syntax (ice-9 syncase))
  14. (define memoized-factorial
  15.   (let ((memo '()))
  16.     (lambda (n)
  17.       (let ((memoized (assq n memo)))
  18.         (if (not (equal? memoized #f))
  19.             (cadr memoized)
  20.             (let ((new-value
  21.                    (if (< n 1)
  22.                        1
  23.                        (* n (memoized-factorial (- n 1))))))
  24.               (set! memo (cons (list n new-value) memo))
  25.               new-value))))))
  26. (define-syntax lazy-cons
  27.   (syntax-rules ()
  28.     ((_ a b) (cons a (delay b)))))
  29. (define (lazy-car p)
  30.   (car p))
  31. (define (lazy-cdr p)
  32.   (force (cdr p)))
  33. (define (lazy-head xs k)
  34.   (if (zero? k)
  35.       '()
  36.       (cons (lazy-car xs) (lazy-head (lazy-cdr xs) (- k 1)))))
  37. (define (naturals n)
  38.   (lazy-cons n (naturals (+ n 1))))
  39. (define (factorial a)
  40.   (lazy-cons (fact a) (factorial (+ a 1))))
  41. (define (fact a)
  42. (let fac ((n a))
  43.   (if (zero? n)
  44.       1
  45.       (* n (fac (- n 1))))))  
  46. (define (lazy-factorial+ n)
  47.   (lazy-head (factorial 0) (+ n 1)))
  48. (define (lazy-factorial n)
  49.   (lazy-car (reverse (lazy-factorial+ n))))
  50.  
  51.  
  52.  
  53. ;1
  54. (define call/cc call-with-current-continuation)
  55. (define exit #f) ; Точка выхода
  56. (define (use-assertions)
  57.   (call/cc (lambda (escape) (set! exit escape))))
  58.  
  59. (define-syntax assert
  60.   (syntax-rules ()
  61.     ((_ expr) (if (not expr) (begin (display "FAILED :") (display (quote expr)) (exit))))))
  62.  
  63. (use-assertions)
  64. (define (1/x x)
  65.   (assert (not (zero? x)))
  66.   (write (/ 1 x))
  67.   (newline))
  68.  
  69. (map 1/x '(1 2 3 0 5))
  70.  
  71. ;2
  72.  
  73. (define (save-data xs filename)
  74.   (with-output-to-file filename
  75.     (lambda ()
  76.       (write xs (current-output-port))
  77.       (newline (current-output-port)))))
  78.  
  79. (define (load-data filename)
  80.   (with-input-from-file filename
  81.     (lambda ()
  82.       (let ((expr (read)))
  83.         (write expr)
  84.         (newline)))))
  85.  
  86. (define (newline-count filename)
  87.   (let ((in (open-input-file filename)))
  88.     (define (count number_string)
  89.       (let ((expr (read in)))
  90.         (if (eof-object? expr)
  91.             (begin
  92.               (close-input-port in)
  93.               number_string)
  94.             (if (not (null? expr))
  95.                 (count (+ number_string 1))
  96.                 (count number_string)))))
  97.     (count 0)))
  98. (define (read-string input-port)
  99.   (let ((c (read-char input-port)))
  100.     (cond
  101.       ((eof-object? c) c); проверка текста на конец-файла
  102.       ((eq? c #\newline) '());
  103.       (else (cons c (read-string input-port))))))
  104. (define (newline-counter filename)
  105.   (let ((in (open-input-file filename)))
  106.     (define (count number_string)
  107.       (let ((expr (read-string in)))
  108.         (if (eof-object? expr)
  109.             (begin
  110.               (close-input-port in)
  111.               number_string)
  112.             (if (not (null? expr))
  113.                 (count (+ number_string 1))
  114.                 (count number_string)))))
  115.     (count 0)))
  116.  
  117. ;3
  118.  
  119. (define memoized-tribonacci
  120.   (let ((memo '()))
  121.     (lambda (n)
  122.       (let ((memoized (assq n memo)))
  123.         (if (not (equal? memoized #f))
  124.             (cadr memoized)
  125.             (let ((new-value
  126.                    (if (<= n 1)
  127.                        0
  128.                        (if (= n 2)
  129.                            1
  130.                            (+ (memoized-tribonacci (- n 3)) (memoized-tribonacci (- n 2)) (memoized-tribonacci (- n 1)))))))
  131.               (set! memo (cons (list n new-value) memo))
  132.               (display memo)
  133.               (newline)
  134.               new-value))))))
  135.  
  136. (define count
  137.   (let ((c 0))
  138.     (lambda ()
  139.       (set! c (+ c 2))
  140.       c)))
  141.  
  142. ;4
  143. (define-syntax my-if
  144.   (syntax-rules ()
  145.     ((_ condition then_action else_action) (begin (let ((a (delay then_action))
  146.                                                         (b (delay else_action)))
  147.                                                     (or (and condition (force a)) (force b)))))))
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top