Advertisement
Guest User

Untitled

a guest
Dec 13th, 2019
109
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.78 KB | None | 0 0
  1. (define (foldl l nv op)
  2. (if (null? l)
  3. nv
  4. (foldl (cdr l) (op nv (car l)) op)))
  5.  
  6. (define (foldr l nv op)
  7. (if (null? l)
  8. nv
  9. (op (car l) (foldr (cdr l) nv op))))
  10.  
  11. (define (acc a b nv op term next)
  12. (if (> a b)
  13. nv
  14. (op (term a) (acc (next a) b nv op term next))))
  15.  
  16. (define (acc-i a b nv op term next)
  17. (if (> a b)
  18. nv
  19. (acc-i (next a) b (op nv (term a)) op term next)))
  20.  
  21. ;Task3
  22. (define (numGame l)
  23. (define (last-digit x) (remainder x 10))
  24. (define (first-digit x)
  25. (if (< x 10)
  26. x
  27. (first-digit (quotient x 10))))
  28. (or (null? l)
  29. (not (not (foldl (cdr l) (car l) (lambda (x y)
  30. (if (or (eqv? x #f) (not (= (last-digit x) (first-digit y))))
  31. #f
  32. y)))))))
  33.  
  34. ;Task4
  35. (define (generate a b l)
  36. (define square (lambda (x) (* x x)))
  37. (acc a
  38. b
  39. '()
  40. (lambda (x y) (if (member (square x) l) (cons x y) y))
  41. (lambda (x) x)
  42. (lambda (x) (+ 1 x))))
  43.  
  44. ;Task5
  45. (define (largestInterval f g a b)
  46. (define (cut-first-n l n)
  47. (if (or (null? l) (= n 0))
  48. l
  49. (cut-first-n (cdr l) (- n 1))))
  50.  
  51. ;Assume that l is not null
  52. (define (get-same-int l)
  53. (define (find-whole l)
  54. (if (or (null? (cdr l)) (not (eqv? (caar l) (caadr l))))
  55. (cdar l)
  56. (find-whole (cdr l))))
  57. (cons (cdar l) (find-whole l)))
  58.  
  59. (define (int-len int)
  60. (+ 1 (- (cdr int) (car int))))
  61.  
  62. (define (find-longest int longest)
  63. (cond ((null? int) longest)
  64. ((eqv? #f (caar int)) (find-longest (cdr int) longest))
  65. (else (let ((curr (get-same-int int)))
  66. (find-longest (cut-first-n int (int-len curr))
  67. (if (> (int-len curr) (int-len longest)) curr longest))))))
  68.  
  69. (let* ((list-interval (acc a b '() cons (lambda (x) x) (lambda (x) (+ 1 x))))
  70. (result-f (map f list-interval))
  71. (result-g (map g list-interval))
  72. (same-pairs (map cons (map (lambda (x y) (= x y)) result-f result-g) list-interval)))
  73.  
  74. (find-longest same-pairs (cons 0 0))))
  75.  
  76. ;Task3 - 2018
  77. (define (meetTwice? f g a b)
  78. (>= (acc-i a
  79. b
  80. 0
  81. (lambda (x y) (if (= (f a) (g a)) (+ x 1) x))
  82. (lambda (x) x)
  83. (lambda (x) (+ 1 x))) 2))
  84.  
  85. ;Task4 - 2018
  86. (define (next-look-and-say seq)
  87. (define (count-same l x)
  88. (if (or (null? l) (not (= x (car l))))
  89. 0
  90. (+ 1 (count-same (cdr l) x))))
  91.  
  92. (if (null? seq)
  93. '()
  94. (let ((same-len (count-same seq (car seq))))
  95. (cons same-len (cons (car seq) (next-look-and-say (list-tail seq same-len)))))))
  96.  
  97. (define test (lambda l (length l)))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement