PonaFly

Untitled

Apr 4th, 2019
171
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Scheme 1.73 KB | None | 0 0
  1. (define (maptree fun tree)
  2. (if (empty? tree) '()
  3. (list (fun (car tree)) (maptree fun (cadr tree)) (maptree fun (caddr tree)))))
  4.  
  5.  
  6. (define (leaf? tree)
  7.   (and (empty? (cadr tree)) (empty? (caddr tree))))
  8.  
  9. (define (remove tree)
  10. (if (empty? tree) '()
  11. (cond
  12. ((and (empty? (cadr tree)) (empty? (caddr tree))) (list (car tree) (remove (cadr tree)) (remove (caddr tree))))
  13. ((empty? (caddr tree)) (list (caadr tree) (remove (cadadr tree)) (remove (car (cddadr tree)))))
  14. ((empty? (cadr tree)) (list (caaddr tree) (remove (car (cdaddr tree))) (remove (cadr (cdaddr tree)))) )
  15. (else (list (car tree) (remove (cadr tree)) (remove (caddr tree)))) )))
  16.  
  17. (define (fun tree)
  18. (if (leaf? tree)
  19. #t
  20. (and (not (or (null? (cadr tree)) (null? (caddr tree)))) (fun (cadr tree)) (fun (caddr tree)))))
  21.  
  22. (define (MAIN tree)
  23. (define (comp tree1)
  24. (if (fun tree1) tree1
  25. (comp (remove tree1))))
  26. (if (empty? tree) null
  27. (if (and (not (empty? (cadr tree))) (empty? (caddr tree))) (list (car tree) (comp(cadr tree)) null)
  28. (if (and (empty? (cadr tree)) (not (empty? (caddr tree)))) (list (car tree) null (comp (caddr tree)))
  29. (comp tree)))))
  30.  
  31.  
  32.  
  33. (define (sort-vkl lst)
  34. (cond
  35. [(empty? lst) empty]
  36. [(cons? lst) (insert (car lst) (sort-vkl (cdr lst)))]))
  37. (define (SumDig k) ;считает сумму цифр
  38. (define (computing n res)
  39. (if (= 0 (quotient n 10)) (+ n res)
  40. (computing (quotient n 10) (+ res (remainder n 10)))))
  41. (computing k 0))
  42. (define (insert n lst)
  43. (cond
  44. [(empty? lst) (list n)]
  45. [else (cond
  46. [(> (SumDig n) (SumDig (car lst))) (cons n lst)] ;по сумме цифр смотрит, куда вставить текущий вариант
  47. [(<= (SumDig n) (SumDig (car lst))) (cons (car lst) (insert n (cdr lst)))])]))
Add Comment
Please, Sign In to add comment