fork(1) download
copy 
  1. (defun del_d (L)
  2. 	(cond ((null L) nil)
  3. 		  ((eq (car L) 'V) (del_d (cdr L)))
  4. 		  (T (cons (car L)(del_d (cdr L)))) ) )
  5.  
  6. (defun comb_not (L)
  7. 	(cond ((null L) nil)
  8. 	      ((eq (car L) '!) (cons (list '! (cadr L))(comb_not (cddr L))))
  9. 		  (T (cons (car L)(comb_not (cdr L)))) ) )
  10.  
  11. (defun comb_k (L)
  12. 	(cond ((null L) nil)
  13. 	      ((eq (cadr L) '&) (cond ((or (atom (car L))(member '! L)) (comb_k (cons (list (caddr L)(car L))(cdddr L))))
  14. 								  (T (comb_k (cons (cons (caddr L)(car L))(cdddr L)))) ) )
  15. 		  (T (cond ((atom (car L)) (cons (cons (car L)())(comb_k (cdr L))))
  16. 				   (T (cons (car L)(comb_k (cdr L)))) ) ) ) )
  17.  
  18. (defun mul1 (a L)
  19. 	(cond ((member '!  L) (cons (cons L a)()))
  20. 		  ((null (cdr L)) (cons (cons (car L) a)()))
  21. 		  (T (append (cons (cons (car L)a)())(mul1 a (cdr L)))) ) )
  22.  
  23. (defun mul_1 (a L)
  24. 	(cond ((and (not (atom a))(not (member '!  a))) (mul1 a L))
  25. 		  ((member '!  L) (cons (list a L)()))
  26. 		  ((null (cdr L)) (cons (list a (car L))()))
  27. 		  (T (append (cons (list a (car L))())(mul_1 a (cdr L)))) ) )
  28.  
  29. (defun mult_2 (L1 L2)
  30. 	(cond ((null (cdr L1)) (mul_1 (car L1) L2))
  31. 		  (T (append (mul_1 (car L1)L2)(mult_2 (cdr L1)L2))) ) )
  32.  
  33. (defun mult_s (L)
  34. 	(cond ((null (cddr L)) (mult_2 (car L)(cadr L)))
  35. 		  (T (mult_s (cons (mult_2 (car L)(cadr L))(cddr L)))) ) )			  
  36.  
  37. (defun makeset (L)
  38. 	(cond ((null L) nil)
  39. 		  ((member (car L) (cdr L)) (makeset (cdr L)))
  40. 		  (T (cons (car L) (makeset (cdr L))) ) ) )
  41.  
  42. (defun makeset_pr (L)
  43. 	(cond ((null L) nil)
  44. 		  ((member (car L) (cdr L)) T)
  45. 		  (T (makeset_pr (cdr L))) ) )
  46.  
  47. (defun flatten_f (S)
  48. 	(cond ((null S) nil)
  49. 		  ((atom S) (cons S ()))	  
  50. 		  (T (append (flatten_f (car S))(flatten_f(cdr S)))) ) )		  
  51.  
  52. (defun log_op_not (L)
  53. 	(cond ((makeset_pr (flatten_f L)) nil)
  54. 		  (T L) ) )
  55.  
  56. (defun log_op (L)
  57. 	(cond ((null L) nil)
  58. 		  (T (cons (log_op_not (makeset (car L)))(log_op (cdr L)))) ) )
  59.  
  60. (defun del_null (L)
  61. 	(cond ((null L) nil)
  62. 		  ((null (car L)) (del_null (cdr L)))
  63. 		  (T (cons (car L)(del_null (cdr L)))) ) )	  
  64.  
  65. (defun l2_l1_pr (L1 L2)
  66. 	(cond ((null L2) T)
  67. 		  ((makeset_pr (flatten_f (cons (car L2) L1))) (l2_l1_pr L1 (cdr L2)))
  68. 		  (T nil) ) )
  69.  
  70. (defun l2_l1_ost (L1 L2)
  71. 	(cond ((null L2) nil)
  72. 		  ((not (makeset_pr (flatten_f (cons (car L2) L1)))) (cond ((not(atom (car L2))) (cons (cadr L2) (l2_l1_ost L1 (cdr L2))))
  73. 																   (T (cons (car L2) (l2_l1_ost L1 (cdr L2)))) ) )
  74. 		  (T (l2_l1_ost L1 (cdr L2))) ) )
  75.  
  76. (defun part_l2_l1 (L1 L2)
  77. 	(cond ((null L2) L1)
  78. 		  ((not(l2_l1_ost L1 (car L2))) nil)
  79. 		  (T (part_l2_l1 L1 (cdr L2))) ) )
  80.  
  81. (defun l1_part_l2 (L1 L2)
  82. 	(cond ((null L2) nil)
  83. 		  ((not(l2_l1_ost (car L2) L1)) (l1_part_l2 L1 (cdr L2)))
  84. 		  (T (cons (car L2) (l1_part_l2 L1 (cdr L2))) ) ) )
  85.  
  86. (defun log_op_lst (L)
  87. 	(cond ((null L) nil)
  88. 		  ((null(part_l2_l1 (car L) (cdr L))) (log_op_lst (cdr L)))
  89. 		  (T (cons (car L) (log_op_lst (l1_part_l2 (car L) (cdr L)))) ) ) )
  90.  
  91. (defun ins_d (L)
  92. 	(cond ((null L) nil)
  93. 		  ((null (cdr L)) L)
  94. 		  ((null (cddr L)) (cons (car L) (cons 'V (cdr L))) )
  95. 		  (T (cons (car L) (cons 'V (ins_d (cdr L)))) ) ) )
  96.  
  97. (defun ins_k (L)
  98. 	(cond ((AND (null (car L)) (not(null (cdr L)))) (ins_k (cdr L)))
  99. 		  ((null L) '(1))
  100. 		  ((null (cdr L)) (cons (ins_d (car L)) nil))
  101. 		  (T (cons (ins_d (car L)) (cons '& (ins_k (cdr L))) ) ) ) )
  102.  
  103. (defun enter_d (L)
  104. 	(del_null (log_op_lst (log_op (mult_s (comb_k (comb_not (del_d L)))))) ) )		
  105.  
  106. (defun print_sok (L)	
  107. 	(ins_k (enter_d L) ))
  108.  
  109. (defun make_not (a L)
  110. 	(cond ((null a) (cons L nil))
  111. 		  ( T (list (cons a L) (cons (list '! a) L))) ) )
  112.  
  113. (defun make_s (L1 L2)
  114. 	(cond ((null (cdr L2)) (make_not (car L2) L1))
  115. 		  ((not (eq (car L2) '!)) (append (make_s (car (make_not (car L2) L1)) (cdr L2)) (make_s (cadr (make_not (car L2) L1)) (cdr L2))) )
  116. 		  (T (make_s L1 (cdr L2))) ) )
  117.  
  118. (defun make_sov (L L3)
  119. 	(cond ((null L3) L)
  120. 		  ((null L) nil)
  121. 		  ((null (l2_l1_ost (car L) L3) ) (cons (car L) (make_sov (cdr L) L3)) )
  122. 		  (T (append (make_s (car L) (l2_l1_ost (car L) L3)) (make_sov (cdr L) L3))) ) )
  123.  
  124. (defun print_sov (L)
  125. 	(ins_k (make_sov (enter_d L) (makeset (flatten_f (enter_d L))))) )
  126.  
  127. (print (print_sok '(A V B V ! B)))
  128. (print (print_sov '(A V B V ! B)))
  129.  
  130. (print (print_sok '(A V B V C V B)))
  131. (print (print_sov '(A V B V C V B)))
  132.  
  133. (print (print_sok '(A V B V ! C V ! A)))
  134. (print (print_sov '(A V B V ! C V ! A)))
  135.  
  136. (print (print_sok '(A & B V B & ! C)))
  137. (print (print_sov '(A & B V B & ! C)))
  138.  
  139. ;(print (print_sok '(D & F V B & ! C & D & N F)))
  140. ;(print (print_sov '(D & F V B & ! C & D & N F)))
  141.  
  142. ;(print (print_sok '(A & C V B & C D)))
  143. ;(print (print_sov '(A & C V B & C D)))
  144.  
Success #stdin #stdout 0.01s 203840KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(1) 
(1) 
((C V A V B)) 
((C V A V B)) 
(1) 
(1) 
((B) & (A V (! C))) 
((C V A V B) & ((! C) V A V B) & (C V (! A) V B) & ((! C) V (! A) V B) &
 (B V A V (! C)) & ((! B) V A V (! C)))
https://ideone.com/PctKhr
language:
Common Lisp (sbcl 1.4.16)
created:
7 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!