From 16582f2c4094249f15d9ab37c1b49beafe542103 Mon Sep 17 00:00:00 2001 From: Mike Vink Date: Thu, 23 Mar 2023 22:57:05 +0100 Subject: fixup --- coding-exercises/2/54.rkt | 18 +++++++- coding-exercises/2/55.rkt | 6 +++ coding-exercises/2/56.rkt | 92 +++++++++++++++++++++++++++++++++++++++++ coding-exercises/2/57.rkt | 96 +++++++++++++++++++++++++++++++++++++++++++ coding-exercises/2/58.rkt | 102 ++++++++++++++++++++++++++++++++++++++++++++++ coding-exercises/2/59.rkt | 29 +++++++++++++ coding-exercises/2/60.rkt | 27 ++++++++++++ 7 files changed, 368 insertions(+), 2 deletions(-) create mode 100644 coding-exercises/2/55.rkt create mode 100644 coding-exercises/2/56.rkt create mode 100644 coding-exercises/2/57.rkt create mode 100644 coding-exercises/2/58.rkt create mode 100644 coding-exercises/2/59.rkt create mode 100644 coding-exercises/2/60.rkt (limited to 'coding-exercises') diff --git a/coding-exercises/2/54.rkt b/coding-exercises/2/54.rkt index c59a91a..ccc50b2 100644 --- a/coding-exercises/2/54.rkt +++ b/coding-exercises/2/54.rkt @@ -1,4 +1,18 @@ #lang racket -(equal? '(this is a list) '(this is a list)) -(equal? '(this is a list) '(this (is a) list)) +(define test-list '(this is a list)) +(define nested-test-list '(this (is a) list)) +(equal? test-list test-list) +(equal? nested-test-list nested-test-list) + +;; Wouldn't it be interesting to define other equals? like only the leaves equal regardless of depth? +(define (rec-equal? seq1 seq2) + (cond ((or (null? seq1) (null? seq2)) true) + ((and (pair? (car seq1)) (pair? (car seq2))) + (and (rec-equal? (car seq1) (car seq2)) + (rec-equal? (cdr seq1) (cdr seq2)))) + (else (and (eq? (car seq1) (car seq2)) + (rec-equal? (cdr seq1) (cdr seq2)))))) + +(rec-equal? test-list test-list) +(rec-equal? nested-test-list test-list) diff --git a/coding-exercises/2/55.rkt b/coding-exercises/2/55.rkt new file mode 100644 index 0000000..7f72cd3 --- /dev/null +++ b/coding-exercises/2/55.rkt @@ -0,0 +1,6 @@ +#lang racket + +;; This is a quoted list containing the symbols quote and abracadabra: +;; '(quote abracadabra) +;; Taking the car of the list returns the quote symbol +(car ''abracadabra) diff --git a/coding-exercises/2/56.rkt b/coding-exercises/2/56.rkt new file mode 100644 index 0000000..7ca4c42 --- /dev/null +++ b/coding-exercises/2/56.rkt @@ -0,0 +1,92 @@ +#lang racket + +(define (variable? x) (symbol? x)) +(define (same-variable? x y) (and (variable? x) (variable? y) (eq? x y))) + +(define (=number? x num) + (and (number? x) (= x num))) +(define (make-sum a1 a2) + (cond ((=number? a1 0) a2) + ((=number? a2 0) a1) + ((and (number? a1) + (number? a2)) (+ a1 a2)) + (else (list '+ a1 a2)))) +(define (make-product m1 m2) + (cond ((or (=number? m1 0) (=number? m2 0)) 0) + ((=number? m1 1) m2) + ((=number? m2 1) m1) + ((and (number? m1) (number? m2)) (* m1 m2)) + (else (list '* m1 m2)))) +(define (make-exponent e p) + (cond ((=number? p 0) 1) + ((=number? p 1) e) + (else (list '** e p)))) + +(define (sum? x) + (and (pair? x) (eq? (car x) '+))) +(define (addend s) (cadr s)) +(define (augend s) (caddr s)) + +(define (product? x) + (and (pair? x) (eq? (car x) '*))) +(define (multiplier p) + (cadr p)) +(define (multiplicand p) + (caddr p)) + +(define (exponent? x) + (and (pair? x) (eq? (car x) '**))) +(define (base expo) + (cadr expo)) +(define (exponent expo) + (caddr expo)) + +(define e '(+ a b)) +(define v1 'a) +(define v2 'b) +(define m1 'a) +(define m2 'b) +(define a1 'a) +(define a2 'b) + +(variable? e) +(same-variable? v1 v2) +(sum? e) +(addend e) +(augend e) +(make-sum a1 a2) +(product? e) +(multiplier e) +(multiplicand e) +(make-product m1 m2) + +(define (deriv expr var) + (cond ((number? expr) 0) + ((variable? expr) + (if (same-variable? expr var) 1 0)) + ((sum? expr) + (make-sum (deriv (addend expr) var) + (deriv (augend expr) var))) + ((product? expr) + (make-sum + (make-product + (multiplier expr) + (deriv (multiplicand expr) var)) + (make-product + (deriv (multiplier expr) var) + (multiplicand expr)))) + ((exponent? expr) + (make-product + (deriv (base expr) var) + (make-product + (exponent expr) + (make-exponent (base expr) (- (exponent expr) 1))))) + (else + (error "unkown expression type -- DERIV" expr)))) + +(deriv '(+ x 3) 'x) +(deriv '(* x y) 'x) +(deriv '(* (* x y) (+ x 3)) 'x) + +(deriv '(** (* 10 a) 3) 'a) +(deriv '(** a 2) 'a) diff --git a/coding-exercises/2/57.rkt b/coding-exercises/2/57.rkt new file mode 100644 index 0000000..5490e5c --- /dev/null +++ b/coding-exercises/2/57.rkt @@ -0,0 +1,96 @@ +#lang racket + +(define (variable? x) (symbol? x)) +(define (same-variable? x y) (and (variable? x) (variable? y) (eq? x y))) + +(define (=number? x num) + (and (number? x) (= x num))) +(define (make-sum a1 a2) + (cond ((=number? a1 0) a2) + ((=number? a2 0) a1) + ((and (number? a1) + (number? a2)) (+ a1 a2)) + (else (list '+ a1 a2)))) +(define (make-product m1 m2) + (cond ((or (=number? m1 0) (=number? m2 0)) 0) + ((=number? m1 1) m2) + ((=number? m2 1) m1) + ((and (number? m1) (number? m2)) (* m1 m2)) + (else (list '* m1 m2)))) +(define (make-exponent e p) + (cond ((=number? p 0) 1) + ((=number? p 1) e) + (else (list '** e p)))) + +(define (sum? x) + (and (pair? x) (eq? (car x) '+))) +(define (addend s) (cadr s)) +(define (augend s) + (cond ((null? (cdddr s)) (caddr s)) + (else (cons '+ (cddr s))))) + +(define (product? x) + (and (pair? x) (eq? (car x) '*))) +(define (multiplier p) + (cadr p)) +(define (multiplicand p) + (cond ((null? (cdddr p)) + (caddr p)) + (else (cons '* (cddr p))))) + +(define (exponent? x) + (and (pair? x) (eq? (car x) '**))) +(define (base expo) + (cadr expo)) +(define (exponent expo) + (caddr expo)) + +(define e '(+ a b)) +(define v1 'a) +(define v2 'b) +(define m1 'a) +(define m2 'b) +(define a1 'a) +(define a2 'b) + +(variable? e) +(same-variable? v1 v2) +(sum? e) +(addend e) +(augend e) +(make-sum a1 a2) +(product? e) +(multiplier e) +(multiplicand e) +(make-product m1 m2) + +(define (deriv expr var) + (cond ((number? expr) 0) + ((variable? expr) + (if (same-variable? expr var) 1 0)) + ((sum? expr) + (make-sum (deriv (addend expr) var) + (deriv (augend expr) var))) + ((product? expr) + (make-sum + (make-product + (multiplier expr) + (deriv (multiplicand expr) var)) + (make-product + (deriv (multiplier expr) var) + (multiplicand expr)))) + ((exponent? expr) + (make-product + (deriv (base expr) var) + (make-product + (exponent expr) + (make-exponent (base expr) (- (exponent expr) 1))))) + (else + (error "unkown expression type -- DERIV" expr)))) + +(deriv '(+ x 3) 'x) +(deriv '(* x y) 'x) +(deriv '(* x y (+ x 3)) 'x) + +(deriv '(** (* 10 a) 3) 'a) +(deriv '(** a 2) 'a) diff --git a/coding-exercises/2/58.rkt b/coding-exercises/2/58.rkt new file mode 100644 index 0000000..17597ed --- /dev/null +++ b/coding-exercises/2/58.rkt @@ -0,0 +1,102 @@ +#lang racket +(require "../../shared/symbolic-differentiation.rkt") +;; infix form with full parentheses +(define (make-sum a1 a2) + (cond ((=number? a1 0) a2) + ((=number? a2 0) a1) + (else (list a1 '+ a2)))) +(define (addend s) + (car s)) +(define (augend s) + (caddr s)) +(define (sum? x) + (and (pair? x) (eq? (cadr x) '+))) + +(define (make-product m1 m2) + (cond ((or (=number? m1 0) (=number? m2 0)) 0) + ((=number? m1 1) m2) + ((=number? m2 1) m1) + (else (list m1 '* m2)))) +(define (product? x) + (and (pair? x) (eq? (cadr x) '*))) +(define (multiplier m) + (car m)) +(define (multiplicand m) + (caddr m)) +(define deriv (make-deriv + make-sum + sum? + addend + augend + make-product + product? + multiplier + multiplicand)) +(deriv '(x + 3) 'x) +(deriv '(x * y) 'x) +(deriv '(x + (3 * (x + (y + 2)))) 'x) + +;; infix form without full parentheses +;; trick was to use recursion to evaluate lower precedence terms first, which +;; means they are applied later +(define (infix-make-sum a1 a2) + (cond ((=number? a1 0) a2) + ((=number? a2 0) a1) + (else (list a1 '+ a2)))) +(define (infix-sum? s) + (cond ((null? s) false) + ((eq? (car s) '+) true) + (else (infix-sum? (cdr s))))) +(define (infix-addend s) + (define (rec seq) + (cond ((null? seq) seq) + ((eq? (car seq) '+) '()) + (else (cons (car seq) (rec (cdr seq)))))) + (let ((a (rec s))) + (if (null? (cdr a)) + (car a) + a))) +(define (infix-augend s) + (cond ((null? s) '()) + ((eq? (car s) '+) (if (null? (cddr s)) (cadr s) (cdr s))) + (else (infix-augend (cdr s))))) +(define test-sum '(a * b * c + d)) +(define test-sum2 '(a + (b + c * d))) +(infix-sum? test-sum) +(infix-addend test-sum) +(infix-augend test-sum) +(infix-sum? test-sum2) +(infix-addend test-sum2) +(infix-augend test-sum2) + +(define (infix-make-product m1 m2) + (cond ((or (=number? m1 0) (=number? m2 0)) 0) + ((=number? m1 1) m2) + ((=number? m2 1) m1) + (else (list m1 '* m2)))) +(define (infix-product? p) + (and (pair? p) (eq? (cadr p) '*))) +(define (infix-multiplier p) + (car p)) +(define (infix-multiplicand p) + (if (null? (cdddr p)) + (caddr p) + (cddr p))) +(define test-prd '(a * b * c)) +(define test-prd2 '(c * d)) +(infix-product? test-prd) +(infix-multiplier test-prd) +(infix-multiplicand test-prd) + +(define infix-deriv (make-deriv + infix-make-sum + infix-sum? + infix-addend + infix-augend + infix-make-product + infix-product? + infix-multiplier + infix-multiplicand)) +(infix-deriv '(3 * x * x + 2 * x + 3 * 4 * x) 'x) +(infix-deriv '(x * y) 'x) +(infix-deriv '(x + 3 * (x + y + 2)) 'x) diff --git a/coding-exercises/2/59.rkt b/coding-exercises/2/59.rkt new file mode 100644 index 0000000..2b10a66 --- /dev/null +++ b/coding-exercises/2/59.rkt @@ -0,0 +1,29 @@ +#lang racket +;; unordered distinct list +(define (element-of-set? x myset) + (cond ((null? myset) false) + ((equal? x (car myset)) true) + (else (element-of-set? x (cdr myset))))) + +(define (adjoin-set x myset) + (if (element-of-set? x myset) + myset + (cons x myset))) + +(define (intersection-set set1 set2) + (cond ((or (null? set1) (null? set2)) '()) + ((element-of-set? (car set1) set2) + (cons (car set1) + (intersection-set (cdr set1) set2))) + (else (intersection-set (cdr set1) set2)))) +(intersection-set (list 1 2 3) (list 'a 2 'c)) + +(define (union-set set1 set2) + (cond ((null? set1) set2) + ((null? set2) set1) + ((not (element-of-set? (car set1) set2)) + (cons (car set1) + (union-set (cdr set1) set2))) + + (else (union-set (cdr set1) set2)))) +(union-set (list 1 2 3) (list 2 3 'c)) diff --git a/coding-exercises/2/60.rkt b/coding-exercises/2/60.rkt new file mode 100644 index 0000000..87eb7be --- /dev/null +++ b/coding-exercises/2/60.rkt @@ -0,0 +1,27 @@ +#lang racket +;; unordered duplicates list +;; can be use if adjoin needs to be fast O(1) +;; append is linear so union is O(n) +;; Tried to make intersection better for case with lot of duplicates and large n +(define (element-of-set? x myset) + (cond ((null? myset) false) + ((equal? x (car myset)) true) + (else (element-of-set? x (cdr myset))))) + +(define (adjoin-set x myset) + (cons x myset)) + +(define (union-set set1 set2) + (append set1 set2)) +(union-set (list 1 1 1 1 1 1 1 2 3) (list 2 2 2 2 2 3 'c)) + +(define (intersection-set set1 set2) + (define (iter s1 s2 result) + (cond ((or (null? s1) (null? s2)) result) + ((and + (not (element-of-set? (car s1) result)) + (element-of-set? (car s1) s2)) + (iter (cdr s1) s2 (cons (car s1) result))) + (else (iter (cdr s1) s2 result)))) + (iter set1 set2 '())) +(intersection-set (list 1 2 2 2 2 2 2 2 3) (list 'a 2 1 1 1 1 1 1 1 1 'c)) -- cgit v1.2.3