File: unit-propagation-correct.lisp

package info (click to toggle)
acl2 8.6%2Bdfsg-2
  • links: PTS
  • area: main
  • in suites: trixie
  • size: 1,111,420 kB
  • sloc: lisp: 17,818,294; java: 125,359; python: 28,122; javascript: 23,458; cpp: 18,851; ansic: 11,569; perl: 7,678; xml: 5,591; sh: 3,976; makefile: 3,833; ruby: 2,633; yacc: 1,126; ml: 763; awk: 295; csh: 233; lex: 197; php: 178; tcl: 49; asm: 23; haskell: 17
file content (167 lines) | stat: -rw-r--r-- 6,479 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
; Copyright (C) 2016, Regents of the University of Texas
; Marijn Heule, Warren A. Hunt, Jr., and Matt Kaufmann
; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.

; See soundness.lisp.  Here we prove a key lemma in support of that book.

(in-package "LRAT")

(include-book "truth-monotone")
(include-book "unit-propagation-monotone")
(include-book "unit-propagation-implies-unsat")

(defthm not-conflicting-literalsp-implies-negate-is-not-member
  (implies (and (member lit a)
                (not (conflicting-literalsp a))
                (literal-listp a))
           (not (member (negate lit) a))))

(defthm not-conflicting-literalsp-implies-negate-is-not-member-subset
  (implies (and (subsetp a1 a2)
                (member lit a2)
                (not (conflicting-literalsp a2))
                (literal-listp a2))
           (not (member (negate lit) a1))))

(defthm subsetp-union-equal-2
  (implies (subsetp x z)
           (subsetp x (union$ y z))))

(defthm not-conflicting-literalsp-subsetp
  (implies (and (subsetp a1 a2)
                (literal-listp a2)
                (not (conflicting-literalsp a2)))
           (not (conflicting-literalsp a1))))

(defthm union-preserves-subsetp-2
  (implies (subsetp y z)
           (subsetp (union$ x y)
                    (union$ x z))))

(defthm conflicting-literalsp-preserved-by-union-equal-cons-2
  (implies (and (not (conflicting-literalsp (union$ a1 a2)))
                (literalp lit)
                (not (member (negate lit) a1))
                (not (member (negate lit) a2)))
           (not (conflicting-literalsp (union$ a1 (cons lit a2))))))

(defthm conflicting-literalsp-union-when-member
  (implies (and (literal-listp a1)
                (not (conflicting-literalsp a1))
                (literal-listp a2)
                (not (conflicting-literalsp a2))
                (member lit a1))
           (iff (conflicting-literalsp
                 (union-equal a1 (cons lit a2)))
                (conflicting-literalsp
                 (union-equal a1 a2))))
  :hints (("Goal"
           :induct (union-equal a1 a2)
           :restrict
           ((not-conflicting-literalsp-implies-negate-is-not-member-subset
             ((a2 (union-equal (cdr a1) (cons (car a1) a2)))))
            (not-conflicting-literalsp-subsetp
             ((a2 (union-equal (cdr a1) (cons (car a1) a2)))))))))

; Start proof of not-conflicting-literalsp-union

(encapsulate
  ()

  (local
   (defthm evaluate-clause-union-equal-cons-2
     (implies (and (not (member-equal lit clause))
                   (equal (evaluate-clause clause
                                           (union-equal assignment (cons lit y)))
                          t))
              (equal (evaluate-clause clause
                                      (union-equal assignment y))
                     t))))

  (local
   (defthm not-conflicting-literalsp-union-lemma
     (implies (and (literal-listp clause)
                   (literal-listp y) ; needed?
                   (not (conflicting-literalsp clause))
                   (not (conflicting-literalsp (union-equal assignment y)))
                   (not (equal (evaluate-clause clause (union-equal assignment y))
                               t)))
              (not (conflicting-literalsp
                    (union-equal assignment
                                 (negate-clause-or-assignment-rec clause y)))))))

  (local
   (defthm evaluate-clause-union-equal-nil
     (equal (evaluate-clause clause (union-equal x nil))
            (evaluate-clause clause x))))

  (local
   (defthm conflicting-literalsp-union-equal-nil
     (iff (conflicting-literalsp (union-equal x nil))
          (conflicting-literalsp x))))

  (defthm not-conflicting-literalsp-union
    (implies (and (literal-listp clause)
                  (not (conflicting-literalsp clause))
                  (not (conflicting-literalsp assignment))
                  (not (equal (evaluate-clause clause assignment)
                              t)))
             (not (conflicting-literalsp
                   (union-equal assignment
                                (negate-clause-or-assignment clause)))))
    :hints (("Goal" :in-theory (enable negate-clause-or-assignment)))))

(defthm clause-or-assignment-p-union
  (implies (and (clause-or-assignment-p clause)
                (clause-or-assignment-p assignment)
                (not (equal (evaluate-clause clause assignment)
                            t)))
           (clause-or-assignment-p
            (union$ assignment
                    (negate-clause-or-assignment clause))))
  :hints (("Goal" :in-theory (enable clause-or-assignment-p))))

(defthm subsetp-union-1
  (subsetp x (union$ x y)))

(defthm unit-propagation-correct-1
  (implies (formula-truep formula assignment)
           (formula-truep
            formula
            (union$ assignment
                    (negate-clause-or-assignment clause))))
  :hints (("Goal" :restrict ((truth-monotone ((a1 assignment))))))
  :rule-classes nil)

(defthm unit-propagation-correct-2
  (implies (and (formula-p formula)
                (clause-or-assignment-p clause)
                (clause-or-assignment-p assignment)
                (equal (unit-propagation formula
                                         indices
                                         (negate-clause-or-assignment clause))
                       t)
                (not (equal (evaluate-clause clause assignment)
                            t)))
           (equal (unit-propagation formula
                                    indices
                                    (union$ assignment
                                            (negate-clause-or-assignment clause)))
                  t))
  :rule-classes nil)

(defthm unit-propagation-correct
  (implies (and (formula-p formula)
                (clause-or-assignment-p clause)
                (clause-or-assignment-p assignment)
                (formula-truep formula assignment)
                (equal (unit-propagation formula
                                         indices
                                         (negate-clause-or-assignment clause))
                       t))
           (equal (evaluate-clause clause assignment)
                  t))
  :hints (("Goal"
           :do-not-induct t
           :use (unit-propagation-correct-1 unit-propagation-correct-2)
           :in-theory (disable formula-p subsetp-union-equal-2))))