Compute the winner of an IRV election
(irv xs) → *
Theorem:
(defthm nat-listp-of-flatten-of-irv-ballot (implies (irv-ballot-p xs) (nat-listp (acl2::flatten xs))))
Theorem:
(defthm irv-termination-helper-lemma (implies (and (irv-ballot-p xs) (consp xs) (not (natp (first-choice-of-majority-p (candidate-ids xs) xs)))) (< (number-of-candidates (eliminate-candidate (candidate-with-least-nth-place-votes 0 (candidate-ids xs) xs) xs)) (number-of-candidates xs))) :rule-classes :linear)
Theorem:
(defthm len-of-consp-not-zero (implies (consp x) (not (equal (len x) 0))))
Theorem:
(defthm list-elements-equal-under-remove-duplicates-equal (iff (list-elements-equal e x) (list-elements-equal e (remove-duplicates-equal x))))
Theorem:
(defthm make-nth-choice-list-and-flatten-for-1-candidate-helper-1 (implies (and (nat-listp (car xs)) (no-duplicatesp-equal (car xs)) (equal (make-nth-choice-list 0 (cdr xs)) (acl2::flatten (cdr xs))) (irv-ballot-p (cdr xs)) (equal (len (remove-duplicates-equal (acl2::flatten xs))) 1)) (equal (make-nth-choice-list 0 xs) (acl2::flatten xs))))
Theorem:
(defthm exactly-one-candidate-gets-all-the-votes (implies (and (irv-ballot-p xs) (equal (number-of-candidates xs) 1)) (equal (max-nats (strip-cdrs (create-nth-choice-count-alist 0 (candidate-ids xs) xs))) (number-of-voters xs))))
Theorem:
(defthm exactly-one-candidate-gets-the-majority-votes (implies (and (irv-ballot-p xs) (consp xs) (<= (number-of-candidates xs) 1)) (< (majority (number-of-voters xs)) (max-nats (strip-cdrs (create-nth-choice-count-alist 0 (candidate-ids xs) xs))))))
Theorem:
(defthm first-choice-of-majority-p-empty-implies-more-than-one-candidate (b* ((cids (candidate-ids xs)) (winner-by-majority (first-choice-of-majority-p cids xs))) (implies (and (irv-ballot-p xs) (consp xs) (not (natp winner-by-majority))) (< 1 (number-of-candidates xs)))) :rule-classes :linear)
Function:
(defun irv (xs) (declare (xargs :guard (irv-ballot-p xs))) (let ((__function__ 'irv)) (declare (ignorable __function__)) (if (mbt (irv-ballot-p xs)) (if (endp xs) nil (b* ((cids (candidate-ids xs)) (step-1-candidate (first-choice-of-majority-p cids xs)) ((when (natp step-1-candidate)) step-1-candidate) (step-2-candidate-to-remove (candidate-with-least-nth-place-votes 0 cids xs)) (new-xs (eliminate-candidate step-2-candidate-to-remove xs))) (irv new-xs))) nil)))
Theorem:
(defthm non-empty-ballot-returns-one-winner (implies (and (irv-ballot-p xs) (consp xs)) (natp (irv xs))) :rule-classes (:rewrite :type-prescription))
Theorem:
(defthm irv-winner-is-a-member-of-initial-candidate-ids (implies (and (irv-ballot-p xs) (consp xs)) (member-equal (irv xs) (candidate-ids xs))))