fork download
  1. ; two homework problems
  2.  
  3. (define (read-line . port)
  4. (define (eat p c)
  5. (if (and (not (eof-object? (peek-char p)))
  6. (char=? (peek-char p) c))
  7. (read-char p)))
  8. (let ((p (if (null? port) (current-input-port) (car port))))
  9. (let loop ((c (read-char p)) (line '()))
  10. (cond ((eof-object? c) (if (null? line) c (list->string (reverse line))))
  11. ((char=? #\newline c) (eat p #\return) (list->string (reverse line)))
  12. ((char=? #\return c) (eat p #\newline) (list->string (reverse line)))
  13. (else (loop (read-char p) (cons c line)))))))
  14.  
  15. (define (inflect xs)
  16. (define (x i) (vector-ref xs i))
  17. (let loop ((lo 0) (left-sum 0)
  18. (hi (- (vector-length xs) 1))
  19. (right-sum 0))
  20. (cond ((< hi lo)
  21. (values lo left-sum right-sum
  22. (abs (- left-sum right-sum))))
  23. ((< left-sum right-sum)
  24. (loop (+ lo 1) (+ left-sum (x lo))
  25. hi right-sum))
  26. (else (loop lo left-sum (- hi 1)
  27. (+ right-sum (x hi)))))))
  28.  
  29. (call-with-values
  30. (lambda () (inflect '#(3 7 9 8 2 5 6)))
  31. (lambda (point left-sum right-sum diff)
  32. (display point) (newline)
  33. (display left-sum) (newline)
  34. (display right-sum) (newline)
  35. (display diff) (newline)))
  36.  
  37. (define (tail n file-name)
  38. (with-input-from-file file-name
  39. (lambda ()
  40. (let ((buffer (make-vector n "")))
  41. (let loop ((i 0) (line (read-line)))
  42. (cond ((eof-object? line)
  43. (do ((j 0 (+ j 1))) ((= j n))
  44. (display (vector-ref buffer (modulo (+ i j) n)))
  45. (newline)))
  46. (else (vector-set! buffer i line)
  47. (loop (modulo (+ i 1) n)
  48. (read-line)))))))))
  49.  
  50. ; (tail 5 "bible.txt")
Success #stdin #stdout 0.01s 7272KB
stdin
Standard input is empty
stdout
3
19
21
2