PasteRack.org
Paste # 37574
2019-04-26 04:23:39

Fork as a new paste.

Paste viewed 146 times.


Embed:

Abheek Kumar Srivastava

  1. #lang racket
  2.  
  3. ;; 1
  4. (define (last a L)
  5.   (if (member a L) (length (member a (reverse L))) 0 )
  6.   )
  7.  
  8. ;; 2
  9. (define (wrap M) (map (lambda (x) (cond ((null? x) (list x)) ((list? x) (wrap x)) (else (list x)))) M))
  10.  
  11. ;; 3
  12. (define (count-parens-all M)
  13.   (cond
  14.     ((null? M) 2)
  15.     ((list? (first M)) (+ (count-parens-all (first M)) (count-parens-all (rest M))))
  16.     (else (count-parens-all (rest M))))
  17.   )
  18.  
  19. ;; 4
  20. (define (insert-left-all new old ls)
  21.   (cond
  22.     ((null? ls) '())
  23.     ((equal? (first ls) old) (cons new (cons old (insert-left-all new old (rest ls)))))
  24.     ((pair? (first ls)) (cons (insert-left-all new old (first ls)) (insert-left-all new old (rest ls))))
  25.     (else (cons (first ls) (insert-left-all new old (rest ls))))
  26.     )
  27.   )
  28.  
  29. ;; 5
  30. (define (invert M)
  31.   (map (lambda (n) (reverse n)) M)
  32.   )
  33.  
  34. ;; 6
  35. (define (select pred L)
  36.   (cond
  37.     ((null? L) '())
  38.     ((pred (first L)) (cons (first L) (select pred (rest L))))
  39.     (else (select pred (rest L)))
  40.     )
  41.   )
  42.  
  43. ;; 7
  44. (define (summatrices M1 M2)
  45.   (map (lambda (x y) (map (lambda (x1 y1) (+ x1 y1)) x y)) M1 M2)
  46.   )
  47.  
  48. ;; 8
  49. (define (swapper a1 a2 M) (map (lambda (x) (swapper2 a1 a2 x)) M))
  50. (define (swapper2 a b M)
  51.   (cond
  52.     ((null? M) '())
  53.     ((pair? M) (swapper a b M))
  54.     ((eq? M a) b)
  55.     ((eq? M b) a)
  56.     (else M)
  57.     )
  58.   )
  59. ;(define (swapper a1 a2 M) (map (lambda (x) (swapper_2 a1 a2 x)) M))
  60. ;(define (swapper_2 a1 a2 M)
  61. ;  (cond
  62. ;    [(pair? M) (map (lambda (x) (swapper_1 a1 a2 x)) M)]
  63. ;    [(atom? M) (swapper_1 a1 a2 M)]
  64. ;    )
  65. ;  )
  66. ;(define (swapper_1 a1 a2 M)
  67. ;  (cond
  68. ;    [(pair? M) (map (lambda (x) (swap a1 a2 x)) M)]
  69. ;    [else (swap a1 a2 M)]
  70. ;    )
  71. ;  )
  72. ;(define (swap a1 a2 a)
  73. ;  (cond
  74. ;    [(null? a) '()]
  75. ;    [(equal? a a1) a2]
  76. ;    [(equal? a a2) a1]
  77. ;    [else a]
  78. ;    )
  79. ;  )
  80. (define (atom? x)
  81.   (and (not (null? x))
  82.        (not (pair? x))))
  83.  
  84. ;; 9
  85. (define (flatten l)
  86.   (cond
  87.     [(empty? l) null]
  88.     [(not (list? l)) (list l)]
  89.     [else (append (flatten (first l)) (flatten (rest l)))]
  90.     )
  91.   )
  92.  
  93. ;; 10
  94. (define (make-tree left root right)
  95.   (list left root right)
  96.   )
  97. (define (left tree) (first tree))
  98. (define (root tree) (second tree))
  99. (define (right tree) (third tree))
  100. (define (binary-tree-insert tree item)
  101.   (cond
  102.     ((null? tree) (make-tree null item null))
  103.     ((> (root tree) item) (make-tree (binary-tree-insert (left tree) item) (root tree) (right tree)))
  104.     (else (make-tree (left tree) (root tree) (binary-tree-insert (right tree) item)))
  105.     )
  106.   )
  107.  
  108. ;; 11
  109. (define (abstract base tfun ffun efun a M)
  110.   (cond
  111.     [(null? M) base]
  112.     [(not (pair? (first M)))
  113.      (if (eq? a (first M))
  114.          (tfun a (rest M))
  115.          (ffun a (first M) (rest M))
  116.          )]
  117.     [else (efun (abstract base tfun ffun efun a (first M))(abstract base tfun ffun efun a (rest M)))])
  118.   )
  119.  
  120. (define (rember* a M) (abstract null rember* (lambda (x y z) (cons y (rember* x z))) cons a M))
  121. (define (count* a M) (abstract 0 (lambda (x z) (add1 (count* x z))) (lambda (x y z) (count* x z)) + a M))
  122.  
  123.  
  124. (let ([cont (lambda (v) (printf "error in call/cc\n"))])
  125.   (with-handlers ((exn? (lambda (exn) (display (exn-message exn)) (newline) (cont #f))))
  126.     (begin
  127.       (call/cc (lambda (k) (set! cont k)       (display (last 1 '())) (newline)))
  128.       (call/cc (lambda (k) (set! cont k)       (display (last 1 '(1 2 3))) (newline) ))
  129.       (call/cc (lambda (k) (set! cont k)       (display (last 2 '(1 2 2 3 3)))  (newline) ))
  130.       (call/cc (lambda (k) (set! cont k)       (display (last 4 '(-1 2 -3 4 0 4 5))) (newline) ))
  131.       (call/cc (lambda (k) (set! cont k)       (display (last 7 '(a 2 3 -1 4 -5 6))) (newline) ))
  132.  
  133.       (printf "Testing done\n")
  134.     )))
  135.  

=>

eval:18:0: abstract: use of a class keyword is not in a

class top-level

  in: abstract

eval:19:0: abstract: use of a class keyword is not in a

class top-level

  in: abstract

eval:20:0: abstract: use of a class keyword is not in a

class top-level

  in: abstract

0

1

3

6

0

Testing done