Advertisement
MarkUa

Untitled

Sep 17th, 2019
1,068
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Lisp 4.57 KB | None | 0 0
  1. (define (not_ item)
  2.    (
  3.       cond ((EQ? item #f) #t)
  4.             ( #t #f)
  5.      
  6.  
  7.     )
  8. )
  9.  
  10. (define (and_  item1 item2)
  11.      
  12.      (cond ((EQ? item1 #f) #f)
  13.            ((EQ? 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.            (( and_ (=( count_ my_list 0) 1)  (and_ (PAIR? my_list) (not_ (LIST? my_list))) ) "pair"  )
  83.            ((< ( count_ my_list 0) 2) "list size less than 2"  )
  84.            ((= ( count_ my_list 0) 2)
  85.                                        (cond ((and_ (not_ (LIST? my_list)) (PAIR? my_list) )
  86.                                               (cons (car my_list) (cons ( cdr my_list) '()))
  87.  
  88.                                               )
  89.                                        ((= 1 1)
  90.                                                (cons (car my_list) (cons ( cadr my_list) '() ))
  91.                                                )
  92.                                              )                  )
  93.            ((> ( count_ my_list 0) 2)
  94.                                     (cons (car my_list) (cons ( cadr my_list) '() ) )
  95.  
  96.             )
  97.  
  98.                     ((= 1 1)  '(car my_list)
  99.  
  100.                            )
  101.            )
  102.      
  103.      
  104.   )
  105. (define (combine_parts  first_part x)
  106.  
  107. (cond ( (EQ? first_part "atom" )
  108.      
  109.           "atom"
  110.         )
  111.       ((EQ? first_part "list size less than 2")  "list size less than 2" )
  112.       ((= 1 1)              
  113.              
  114.               (cons first_part (cons  (second x) '() ))
  115.  
  116.        )
  117. )
  118.  
  119.  
  120.   )
  121. (define (create_new item )
  122.      (combine_parts  (first  item) item)
  123.  
  124.  )
  125.  #|(define object_to_process '( 2 44 5 . 3  ) )
  126.  (create_new object_to_process)
  127.  (display object_to_process)
  128. (display "\n")
  129.  
  130. (combine_parts  (first  object_to_process) object_to_process)
  131.  
  132.  (define object_to_process1 '( (2 44)  5 . 3  ) )
  133.  (display object_to_process1)
  134. (display "\n")
  135.  
  136. (combine_parts  (first  object_to_process1) object_to_process1)
  137.  
  138. (define object_to_process2 '( 2 44 5 2 4 5 . 3  ) )
  139.  
  140.  (display object_to_process2)
  141. (display "\n")
  142.  
  143. (combine_parts  (first  object_to_process2) object_to_process2)
  144.  
  145.  (define object_to_process3 '( 2 44  ) )
  146.  
  147.  (display object_to_process3)
  148. (display "\n")
  149.  
  150. (combine_parts  (first  object_to_process3) object_to_process3)|#
  151.  
  152. (create_new '(1 4 5 3 4 4))
  153. (create_new '(1 4 5 3 4 4 4 . 5))
  154. (create_new '(1 4 5 3 4 (4)))
  155. (create_new '())
  156. (create_new "")
  157. (create_new '( (1 . 4) 4))
  158.  
  159. (create_new '(1 4 5 3 4 4))
  160. (create_new '(1 4 5 3 4 4 4 . 5))
  161. (create_new '(1 4 5 3 4 (4)))
  162. (create_new '(1 . 3))
  163. (create_new "")
  164. (create_new '( (1 . 4) 4 3 . 4))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement