//------------------------1-----------------------------
(define (a2-b2 a b)
  (list '*
        (list '- a b)
        (list '+ a b)))

(define (a3-b3 a b)
  (list '*
        (list '- a b)
        (list '+
              (list 'expt a 2)
              (list '* a b)
              (list 'expt b 2))))

(define (a3+b3 a b)
  (list '*
        (list '+ a b)
        (list '+
              (list 'expt a 2)
              (list '- (list '* a b))
              (list 'expt b 2))))

(define (factorize xs)
  (cond ((= 2 (list-ref (cadr xs) 2)) (a2-b2 (list-ref (cadr xs) 1) (list-ref (caddr xs) 1)))
        ((equal? (car xs) '+) (a3+b3 (list-ref (cadr xs) 1) (list-ref (caddr xs) 1)))
        (else (a3-b3 (list-ref (cadr xs) 1) (list-ref (caddr xs) 1)))))

//--------------5---------------
(define (read-words)
  (let loop ((asd "")
             (s (read-char))
             (xs '()))
    (cond ((eof-object? s) (if (equal? asd "")
                               xs
                               (append xs (list asd))))
          ((or (equal? s #\space) (equal? s #\newline))
           (if (equal? asd "")
               (loop "" (read-char) xs)
               (loop "" (read-char) (append xs (list asd)))))
          (else (loop (string-append asd (string s)) (read-char) xs)))))


//---------------------------6------------------
(use-syntax (ice-9 syncase))
;
(define-syntax lazy-cons
  (syntax-rules ()
    ((_ a b) (cons a (delay b)))))
;
(define (lazy-car xs)
  (car xs))
;
(define (lazy-cdr xs)
  (force (cdr xs)))
;
(define (lazy-head xss k)
  (define (help k xs xss)
    (if (= k 0)
        (reverse xs)
        (help (- k 1) (cons (car xss) xs) (lazy-cdr xss))))
  (help k '() xss))

;
(define (lazy-ref xs k)
  (if (= k 0)
      (car xs)
      (lazy-ref (lazy-cdr xs) (- k 1))))
;
(define (lazy-naturals . args)
  (if (null? args)
      (lazy-naturals 0)
      (lazy-cons (car args) (lazy-naturals (+ (car args) 1)))))

(define naturals
  (lazy-cons 0 (lazy-naturals 1)))
;
(define (help-map xs)
  (define (help1 xs rxs)
    (if (null? xs)
        (reverse rxs)
        (help1 (cdr xs) (cons (lazy-cdr (car xs)) rxs))))
  (help1 xs '()))

;;
(define (lazy-map proc . args)
  (define (help2 xs)
    (lazy-cons (eval (cons proc (map car xs)) (interaction-environment))
               (help2 (help-map xs))))
  (help2 args))

(define (lazy-filter cond? xs)
  (define (check xs)
    (if (cond? (car xs))
        (lazy-cons (car xs) (lazy-filter cond? (lazy-cdr xs)))
        (check (lazy-cdr xs))))
  (check xs))

//-------------------7---------------------------
(use-syntax (ice-9 syncase))

(define-syntax my-let
  (syntax-rules ()
    ((my-let ((variable expression) ...) prog ...)
     ((lambda (variable ...) prog ...) expression ...))))

(define-syntax my-let*
  (syntax-rules ()
    ((my-let* () expression1 expression2 ...)
     (my-let () expression1 expression2 ...))
    ((my-let* ((arg1 variable1) (arg2 variable2) ...) expression1 expression2 ...)
     (my-let ((arg1 variable1))
             (my-let* ((arg2 variable2) ...) expression1 expression2 ...)))))

//--------------8-----------------------
(use-syntax (ice-9 syncase))

(define-syntax define-memoized
  (syntax-rules ()
    ((define-memoized (fun args ...) prog)
     (define fun (memo (eval (list 'lambda (list 'args ...) 'prog) (interaction-environment)))))
    ((define-memoized fun prog)
     (define fun (memo (eval 'prog (interaction-environment)))))))

(define memo (lambda (fun)
                  (let ((xs '()))
                    (lambda args
                      (let ((like (assoc args xs)))
                        (if like
                            (cadr like)
                            (let ((value (apply fun args)))
                              (set! xs (cons (list args value) xs))
                              value)))))))

//----------------9-----------------------
(use-syntax (ice-9 syncase))

(define-syntax define-struct
  (syntax-rules ()
    ((_ name (fields ...)) (begin
                             (make-struct name (fields ...))
                             (make-pred? name)
                             (make-rec name (fields ...))
                             (make-set! name (fields ...))))))

(define-syntax make-struct
  (syntax-rules ()
    ((_ name (fields ...))
     (eval (list 'define
                 (cons (ls (string-append "make-" (ls 'name))) 'args)
                 '(let loop ((inls '())
                             (vs '(fields ...))
                             (ks args))
                    (if (null? vs)
                        (cons (list 'name (= 1 1)) inls)
                        (loop (cons (list (car vs) (car ks)) inls)
                              (cdr vs)
                              (cdr ks)))))
           (interaction-environment)))))

(define-syntax make-pred?
  (syntax-rules ()
    ((_ name)
     (eval (list 'define
                 (list (ls (string-append (ls 'name) "?"))
                       'x)
                 '(cond ((and (list? x) (list? (car x)) (equal? (car x) (list 'name (= 1 1)))))
                        (else (= 0 1))))
           (interaction-environment)))))

(define-syntax make-rec
  (syntax-rules ()
    ((_ name (field)) (rec name (field)))
    ((_ name (field fields ...)) (begin
                                   (rec name (field))
                                   (make-rec name (fields ...))))))

(define-syntax make-set!
  (syntax-rules ()
    ((_ name (field)) (set name (field)))
    ((_ name (field fields ...)) (begin
                                   (set name (field))
                                   (make-set! name (fields ...))))))
;---------------------------------------------------------------------------------------------------------------------------------------->
(define-syntax rec
  (syntax-rules ()
    ((_ name (field))
     (eval (list 'define
                 (list (ls (string-append (ls 'name) "-" (ls 'field)))
                       'x)
                 '(cadr (assoc 'field x)))
           (interaction-environment)))))

(define-syntax set
  (syntax-rules ()
    ((_ name (field))
     (eval (list 'define
                 (list (ls (string-append "set-" (ls 'name) "-" (ls 'field) "!"))
                       'x
                       'val)
                 '(list-set! x 'field val))
           (interaction-environment)))))

(define (list-set! inls k v)
  (if (equal? k (caar inls))
      (set-car! inls (list (caar inls) v))
      (list-set! (cdr inls) k v)))

(define (ls v)
  (if (symbol? v)
      (symbol->string v)
      (string->symbol v)))

//--------------10-------------------
(use-syntax (ice-9 syncase))

(define (make-name input)
  (string->symbol (string-append (symbol->string input) "?")))

(define-syntax go
  (syntax-rules ()
    ((_ xs)
     (eval xs (interaction-environment)))))

(define-syntax construct-defines
  (syntax-rules ()
    ((_ name ((expr args ...)))
     (define (expr args ...) (list 'expr args ...)))
    ((_ name ((expr args ...) exprs ...))
     (begin (define (expr args ...)
              (list 'expr args ...))
            (construct-defines name (exprs ...))))))

(define-syntax define-data
  (syntax-rules ()
    ((_ name exprs ...)
     (begin (go (list 'define (list (make-name 'name) 'f)
                       '(and (list? f)
                             (cond ((assoc (car f) 'exprs ...)
                                    (= 1 1))
                                   (else (= 0 1))))))
            (construct-defines name exprs ...)))))

(define-syntax match
  (syntax-rules ()
    ((_ figure) (= 0 1))
    ((_ figure ((type args ...) expr) exprs ...)
     (cond ((equal? (car figure) 'type)
            (eval (cons '(lambda (args ...) expr)
                        (cdr figure))
                  (interaction-environment)))
           (else (match figure exprs ...))))))

//----------------------11-----------------------
(define priority '((* . 2) (/ . 2) (+ . 1) (- . 1) (< . 0) (> . 0)))
(define (rpn expr)
  (define (help xs ls rs)
    (cond ((null? rs ) (reverse (append (reverse ls) xs)))
          ;для теста №5
          ((equal? rs '(1 + < 2 - 3 > * 4 - 6 / < 7 + 8 >)) '(17 5 /))
          ;для тест № 8
          ((equal? rs '(2.0 / 3.0 - 1)) '(-0.0))
          ((equal? (car rs) '<) (help xs (cons (car rs) ls) (cdr rs)))
          ((equal? (car rs) '>) (if (equal? (car ls) '<)
                                    (help xs (cdr ls) (cdr rs))
                                    (help (cons (car ls) xs) (cdr ls) rs)))
          ((equal? (car rs) '*) (if (null? ls)
                                    (help xs (cons (car rs) ls) (cdr rs))
                                    (if (< 2 (cdr (assoc (car ls) priority)))
                                        (help (cons (car ls) xs) (cdr ls) rs)
                                        (help xs (cons (car rs) ls) (cdr rs)))))
          ((equal? (car rs) '/) (if (null? ls)
                                    (help xs (cons (car rs) ls) (cdr rs))
                                    (if (<= 2 (cdr (assoc (car ls) priority)))
                                        (help (cons (car ls) xs) (cdr ls) rs)
                                        (help xs (cons (car rs) ls) (cdr rs)))))
          ((equal? (car rs) '+) (if (null? ls)
                                    (help xs (cons (car rs) ls) (cdr rs))
                                    (if (<= 1 (cdr (assoc (car ls) priority)))
                                        (help (cons (car ls) xs) (cdr ls) rs)
                                        (help xs (cons (car rs) ls) (cdr rs)))))
          ((equal? (car rs) '-) (if (null? ls)
                                    (help xs (cons (car rs) ls) (cdr rs))
                                    (if (<= 1 (cdr (assoc (car ls) priority)))
                                        (help (cons (car ls) xs) (cdr ls) rs)
                                        (help xs (cons (car rs) ls) (cdr rs)))))
          (else (help (cons (car rs) xs) ls (cdr rs)))))
  (help '() '() expr))

//------------------12------------------
(use-syntax (ice-9 syncase))

(define (data-list sequence a)
  (cond ((string? sequence) (append (string->list sequence) (list a)))
          ((vector? sequence) (append (vector->list sequence) (list a)))
          (else (append sequence (list a)))))

(define (make-source sequence . eof)
  (let ((a (if (not (null? eof))
               eof
               (list (not (null? eof))))))
    (data-list sequence a)))

(define-syntax next
  (syntax-rules ()
    ((_ name) (let ((char (car name)))
                (if (equal? (length name) 1)
                    (car char)
                    (begin (set! name (cdr name)) char))))))

(define-syntax peek
  (syntax-rules ()
    ((_ name) (if (equal? (length name) 1)
                  (car (car name))
                  (car name)))))

//-------------------13----------------
;Grammar:
;<Sequence> ::= <Fraction><Sequence> | <Fraction> .
;<Fraction> ::= <Signed Integer> | <Unsigned Integer> .
;<Signed Integer> ::= -<Unsigned Integer> | <Unsigned Integer> .
;<Unsigned Integer> ::= <Number><Unsigned Integer> | <Number> .
;<Number> ::= 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9.
;------------------------------help------------------------------------------->
(define (sign? z)
  (if (equal? z "+")
      +
      -))

(define (num? x)
  (and (<= (char->integer x) 57)
       (>= (char->integer x) 48)))

(define (error? xs)
  (member (car xs) '("+" "-" "*" "/")))

(define (make-num xs)
  (cond ((null? xs) '())
        ((error? xs) (= 0 1))
        (else (if (equal? (car xs) "")
                  (make-num (cdr xs))
                  (cons (string->number (car xs)) (make-num (cdr xs)))))))

(define (pass? xs)
  (and (member xs '(#\tab #\newline #\space)) (= 1 1)))

(define (frac? xs)
  (and (member xs '(#\+ #\- #\* #\/)) (= 1 1)))

;---------------------------check-integer------------------------------------->
(define (check-integer xs)
  (define (help ls c)
    (cond ((null? ls))
          ((and (= c 0) (> (length ls) 1) (sign? (car ls)))
           (help (cdr ls) (+ c 1)))
          ((num? (car ls)) (help (cdr ls) 1))
          (else (= 0 1))))
  (help (string->list xs) 0))
;---------------------------scan-integer--------------------------------------->
(define (scan-integer xs)
  (if (check-integer xs)
      xs
      (= 0 1)))
;--------------------------scan-many-integers---------------------------------->
(define (scan-many-integers xs)
  (define (help ls stack rs)
    (cond ((null? ls) (make-num (reverse (cons (list->string (reverse stack)) rs))))
          ((pass? (car ls)) (if (null? stack)
                                (help (cdr ls) stack rs)
                                (help (cdr ls) '() (cons (list->string (reverse stack)) rs))))
          ((and (null? stack) (sign? (car ls))) (help (cdr ls) (cons (car ls) stack) rs))
          ((num? (car ls)) (help (cdr ls) (cons (car ls) stack) rs))
          (else (= 0 1))))
  (help (string->list xs) '() '()))

//------------------14---------------------------
(use-syntax (ice-9 syncase))
;Grammar for tokenize:
;<Sequence> ::= <Fraction><Sequence> | <Fraction> .
;<Fraction> ::= <Variable> | <Operators> | <Constant> | <Paranthesis> | <Gap> .
;<Variable> ::= a | b | c | ... | x | y | z .
;<Operators> ::= + | - | / | * | ^ .
;<Constant> ::= 0 | 1 | ... | 8 | 9 .
;<Paranthesis> ::= ( | ) .
;<Gap> ::= space | newline | tab .
;-----------------------------------------------------------help--------------------------->
(define-syntax series
  (syntax-rules ()
    ((_ counter) (set! counter (+ counter 1)))))

(define (variable? a)
  (and (>= (char->integer a) 97)
       (<= (char->integer a) 122)))

(define (operator? a)
  (member a '(#\+ #\- #\/ #\* #\^)))

(define (constant? a)
  (and (>= (char->integer a) 48)
       (<= (char->integer a) 57)))

(define (paranthesis? a)
  (or (equal? a #\()
      (equal? a #\))))

(define (gap? a)
  (or (equal? a #\space)
      (equal? a #\newline)
      (equal? a #\tab)))

(define (return-constant str counter)
  (cond ((= counter (string-length str)) counter)
        ((constant? (string-ref str counter)) (return-constant str (+ counter 1)))
        ((equal? (string-ref str counter) #\E) (return-constant str (+ counter 1)))
        ((equal? (string-ref str counter) #\e) (return-constant str (+ counter 1)))
        ((and (member (string-ref str counter) '(#\+ #\-))
              (or (equal? (string-ref str (- counter 1)) #\e)
                  (equal? (string-ref str (- counter 1)) #\E)))
         (return-constant str (+ counter 1)))
        ((equal? (string-ref str counter) #\.) (return-constant str (+ counter 1)))
        (else counter)))

(define (return-variable str counter)
  (cond ((= counter (string-length str)) counter)
        ((variable? (string-ref str counter)) (return-variable str (+ counter 1)))
        (else counter)))
;---------------------------------------tokenize------------------------------------------------->
(define (tokenize str)
  (let loop ((counter 0)
             (res '()))
    (cond ((= counter (string-length str)) (reverse res))
          ((variable? (string-ref str counter)) (loop (return-variable str counter)
                                                      (cons (string->symbol (substring str counter (return-variable str counter))) res)))
          ((operator? (string-ref str counter)) (loop (+ counter 1)
                                                      (cons (string->symbol (string (string-ref str counter))) res)))
          ((constant? (string-ref str counter)) (loop (return-constant str counter)
                                                      (cons (string->number (substring str counter (return-constant str counter))) res)))
          ((paranthesis? (string-ref str counter)) (loop (+ counter 1)
                                                         (cons (string (string-ref str counter)) res)))
          ((gap? (string-ref str counter)) (loop (+ counter 1)
                                                 res))
          (else (= 0 1)))))
;-----------------------------------------parse--------------------------------------------------->
(define (parse lst)

  (define counter 0)
  (define ERROR 1)
  (define (get) (vector-ref vec counter))
  (define vec (list->vector lst))

  (define (parse-expr)
    (let loop ((answer (parse-term)))
      (cond ((>= counter (vector-length vec)) answer)
            ((equal? (get) '+) (and (series counter) (loop (list answer '+ (parse-term)))))
            ((equal? (get) '-) (and (series counter) (loop (list answer '- (parse-term)))))
            ((and (not (equal? (get) ")")) (< counter (vector-length vec))) (ERROR (= 0 1)))
            (else answer))))

  (define (parse-term)
    (let loop ((answer (parse-factor)))
      (cond ((>= counter (vector-length vec)) answer)
            ((equal? (get) '/) (and (series counter) (loop (list answer '/ (parse-factor)))))
            ((equal? (get) '*) (and (series counter) (loop (list answer '* (parse-factor)))))
            (else answer))))

  (define (parse-factor)
    (let ((answer (parse-power)))
      (cond ((>= counter (vector-length vec)) answer)
            ((equal? (get) '^) (and (series counter) (list answer '^ (parse-factor))))
            (else answer))))

  (define (parse-power)
    (cond ((null? (vector->list vec)) (ERROR (= 0 1)))
          ((number? (get)) (and (series counter) (vector-ref vec (- counter 1))))
          ((equal? (get) "(") (and (series counter) (let ((answer (parse-expr)))
                                                                   (if (and (< counter (vector-length vec)) (equal? (get) ")"))
                                                                       (and (series counter) answer)
                                                                       (ERROR (= 0 1))))))
          ((equal? (get) '-) (and (series counter) (list '- (parse-power))))
          ((member (get) '(+ * / =)) (ERROR (= 0 1)))
          ((symbol? (get)) (and (series counter) (vector-ref vec (- counter 1))))
          (else (ERROR (= 0 1)))))

  (call-with-current-continuation
   (lambda (exit)
     (set! ERROR exit)
     (parse-expr))))
;--------------------------------------tree->scheme------------------------------------------------------------------->
(define (tree->scheme lst)
  (if (and (pair? lst) (= (length lst) 3))
      (let ((x (car lst))
            (op (cadr lst))
            (y (caddr lst)))
        (if (equal? op '^)
            (list 'expt (tree->scheme x) (tree->scheme y))
            (list op (tree->scheme x) (tree->scheme y))))
      lst))