Advertisement
MarkUa

Untitled

Sep 17th, 2019
955
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Lisp 3.55 KB | None | 0 0
  1. (define (not_ item)
  2.    (
  3.       cond ((EQV? item #f) #t)
  4.             ( #t #f)
  5.      
  6.  
  7.     )
  8. )
  9.  
  10. (define (and_  item1 item2)
  11.      
  12.      (cond ((EQV? item1 #f) #f)
  13.            ((EQV? item2 #f) #f)
  14.      (#t #t)
  15.      )
  16.  
  17. )
  18.  
  19. (define (or_ item1 item2)
  20.         ( not_ (and_ (not_ item1) (not_ item2) ) )
  21.  
  22. )
  23. ; list length
  24. (define (count_ lst len)
  25.  
  26.  (cond ((EQV? lst '() ) len  )
  27.         ((not_ (PAIR? lst)) len )
  28.         ( (= 1 1)  (
  29.                     count_ (cdr lst  ) (+ len 1)
  30.                           ))))
  31. ; reverse list
  32. (define (reverse_ list_  result  position )
  33.     (define len  ( count_ list_ 0) )
  34.     (cond ((= len 0)  result  )
  35.           ( (and_ (= position 1  ) (and_ (PAIR?  list_) (LIST? list_)) )
  36.  
  37.                             (cons  (car list_)  result ) )
  38.              ( (and_  (= position 1  ) (and_ (PAIR?  list_) (not_ (LIST? list_))) )
  39.  
  40.                           (cons   list_   result ) )
  41.              ( (= 1 1)
  42.                         (reverse_ (cdr list_) (cons (car list_) result  )  ( - position 1) )
  43.                      )
  44.      )      
  45. )
  46. ; check second part for different issues
  47. (define (check li copy possible_pair_position deep)
  48.        (define len  ( count_ li 0) )
  49.      ;  (display len)
  50.       (cond ((= len 0 )  copy  )
  51.             ( (and_ (=  possible_pair_position 1  ) (and_ (PAIR?  li) (LIST? li)) )
  52.  
  53.                          (reverse_ (cons  (car li)  copy ) '() deep)     )
  54.              ( (and_ (and_ (=  possible_pair_position 1  )  (PAIR?  li)) (not_ (LIST? li)) )
  55.  
  56.                          (reverse_ (cons   li   copy ) '() deep)  )
  57.            ( (=  possible_pair_position 1  )
  58.  
  59.              (cons  (car li) copy ) )
  60.            ((= 1 1)
  61.                
  62.       (check (cdr li  ) (cons (car li) copy )   (- possible_pair_position 1) deep )                
  63.             )
  64.        )
  65.  
  66.  )
  67. ;second part formatting
  68. (define (second my_list)
  69.      (define len  ( count_ my_list 0) )
  70.      (cond ((< len 2) "less than 2")
  71.            ((= len 2) '() )
  72.            ((= 1 1) ( check (cddr my_list) '()  (- len 2) (- len 2) )
  73.                            )
  74.            )
  75.        
  76.   )
  77.  
  78. ;first part formatting
  79. (define (first my_list)
  80.    
  81.      (cond ((and_  (not_ (LIST? my_list)) (not_ (PAIR? my_list))) "atom" )
  82.            ((< ( count_ my_list 0) 2) "list size less than 2"  )
  83.            ((= ( count_ my_list 0) 2)
  84.                                        (cond ((and_ (not_ (LIST? my_list)) (PAIR? my_list) )
  85.                                               (cons (car my_list) (cons ( cdr my_list) '()))
  86.  
  87.                                               )
  88.                                        ((= 1 1)
  89.                                                (cons (car my_list) (cons ( cadr my_list) '() ))
  90.                                                )
  91.                                              )                  )
  92.            ((> ( count_ my_list 0) 2)
  93.                                     (cons (car my_list) (cons ( cadr my_list) '() ) )
  94.  
  95.             )
  96.  
  97.                     ((= 1 1)  '(car my_list)
  98.  
  99.                            )
  100.            )
  101.      
  102.      
  103.   )
  104. (define (combine_parts  first_part x)
  105.  
  106. (cond ( (EQ? first_part "atom" )
  107.      
  108.           "atom"
  109.         )
  110.       ((EQ? first_part "list size less than 2")  "list size less than 2" )
  111.       ((= 1 1)              
  112.              
  113.               (cons first_part (cons  (second x) '() ))
  114.  
  115.        )
  116. )
  117.  
  118.  
  119.   )
  120.  (define object_to_process '( 2 44 5 . 3  ) )
  121.  
  122.  (display object_to_process)
  123. (display "\n")
  124.  
  125. (combine_parts  (first  object_to_process) object_to_process)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement