From 2c85332e1e402653ed44ea1a5248cb7d11259389 Mon Sep 17 00:00:00 2001 From: bd Date: Sun, 9 Jun 2024 18:29:13 -0600 Subject: AoC 2020.1 p2 --- combinations/combinations-test.scm | 6 ++ report-repair/combinations.scm | 1 + report-repair/main.scm | 7 +-- report-repair/rr-test.scm | 123 +++++++++++++++++-------------------- report-repair/rr.scm | 100 +++++++++++++----------------- 5 files changed, 107 insertions(+), 130 deletions(-) create mode 120000 report-repair/combinations.scm diff --git a/combinations/combinations-test.scm b/combinations/combinations-test.scm index 60f5fd1..0f1423d 100644 --- a/combinations/combinations-test.scm +++ b/combinations/combinations-test.scm @@ -34,4 +34,10 @@ '((1 2 3 4 5)) (combinations '(1 2 3 4 5) 5)) +(test-equal "combinations numbers" + '((979 366) + (979 675) + (366 675)) + (combinations '(979 366 675) 2)) + (test-end "harness") diff --git a/report-repair/combinations.scm b/report-repair/combinations.scm new file mode 120000 index 0000000..74f5336 --- /dev/null +++ b/report-repair/combinations.scm @@ -0,0 +1 @@ +../combinations/combinations.scm \ No newline at end of file diff --git a/report-repair/main.scm b/report-repair/main.scm index cdfed63..c6074ef 100755 --- a/report-repair/main.scm +++ b/report-repair/main.scm @@ -1,7 +1,4 @@ -#!/run/current-system/profile/bin/guile \ --e main -s -!# - +;; -*- compile-command: "guile -L . -e main -s main.scm 3 < input.txt"; -*- (use-modules (rr) ((ice-9 rdelim)) (ice-9 binary-ports)) @@ -15,5 +12,5 @@ (loop (string-append result line " ")))))) (define (main args) - (display (rr (stdin-to-str))) + (display (rr (stdin-to-str) (string->number (cadr args)))) (newline)) diff --git a/report-repair/rr-test.scm b/report-repair/rr-test.scm index 7d75c09..3661c64 100644 --- a/report-repair/rr-test.scm +++ b/report-repair/rr-test.scm @@ -5,79 +5,68 @@ (test-begin "harness") -(test-equal "friendship 1" - '(1 . 2019) - (return-friendship-pair 1)) - -(test-equal "friendship 1596" - '(1596 . 424) - (return-friendship-pair 1596)) - -(test-equal "small report" - '((0 . 2020) - (1 . 2019) - (2 . 2018) - (3 . 2017) - (4 . 2016) - (5 . 2015)) - (report->pairs "0 1 2 3 4 5")) - -(test-assert "equivalent pair" - (equivalent-pair? - '(1 . 4) - '((5 . 6) - (1 . 5) - (3 . 7) - (4 . 1) - (6 . 2)))) - -(test-equal "no equivalent pair" - #f - (equivalent-pair? - '(1 . 4) - '((5 . 6) - (1 . 5) - (3 . 7) - (6 . 2)))) - -(test-equal "found equivalent pair" - '(1 . 5) - (return-equivalent-pair - '((5 . 6) - (1 . 5) - (3 . 7) - (5 . 1) - (6 . 2)))) - -(test-error "no equivalent pairs" +(test-equal "completed set size 1" + '(1 2019) + (make-complete-set '(2019))) + +(test-equal "completed set size 1" + '(366 675 979) + (make-complete-set '(675 979))) + +(test-equal "generate sets compatible" + '((675 979 366) + (366 979 675) + (979 366 675)) + (generate-sets '(979 366 675) 3)) + +(test-assert "does not include all" + (not (includes-all? '(1 2 3) '(1 2 4 5 6)))) + +(test-assert "includes all" + (includes-all? '(1 2 3) '(1 2 3 5 6))) + +(test-error "no two inputs add to 2020" #t - (return-equivalent-pair - '((5 . 6) - (1 . 5) - (3 . 7) - (6 . 2)))) + (get-2020-terms '(979 366 675) + 2)) -(test-equal "multiply pair 1" - 8 - (multiply-pair (cons 1 8))) +(test-error "2020 not present" + #t + (get-2020-terms '(1 2 3) + 1)) + +(test-equal "2020 is present" + '(2020) + (get-2020-terms '(2020 1 2 3) + 1)) + +(test-equal "three elements which add to 2020" + '(675 979 366) + (get-2020-terms '(979 366 675) + 3)) -(test-equal "multiply pair 2" - 24 - (multiply-pair (cons 3 8))) +(test-error "three elements which do not add to 2020" + #t + (get-2020-terms '(979 365 675) + 3)) -(test-equal "task-complete 1" - 1020099 - (rr "1009 237 791 478 1537 1011 1628")) +(test-equal "some two elements add to 2020" + '(299 1721) + (get-2020-terms '(1721 979 366 299 675 1456) + 2)) -(test-equal "task-complete 2" +(test-equal "some three elements add to 2020" + '(675 979 366) + (get-2020-terms '(1721 979 366 299 675 1456) + 3)) + +(test-equal "rr wrapper 2" 514579 - (rr "1721 -979 -366 -299 -675 -1456 -")) + (rr "1721 979 366 299 675 1456" 2)) + +(test-equal "rr wrapper 3" + 241861950 + (rr "1721 979 366 299 675 1456" 3)) (test-end "harness") diff --git a/report-repair/rr.scm b/report-repair/rr.scm index b327d3c..6adee86 100644 --- a/report-repair/rr.scm +++ b/report-repair/rr.scm @@ -2,64 +2,48 @@ -e main -s !# (define-module (rr) + #:use-module (combinations) #:use-module (srfi srfi-1) + #:use-module (ice-9 format) #:use-module (ice-9 exceptions) #:export (rr - multiply-pair - return-equivalent-pair - equivalent-pair? - return-friendship-pair - report->pairs)) - - -(define (rr str) - (multiply-pair - (return-equivalent-pair - (report->pairs str)))) - -(define (multiply-pair pair) - (* (car pair) - (cdr pair))) - -(define (return-equivalent-pair pairs) - "Given PAIRS friendship pairs, returns the -ones that are found to be friends. Throws -friendship-exception if no friends are found. - -We do NOT care if there are multiple pairs. -Return the first one." - (let loop ((pair (car pairs)) (pairs (cdr pairs))) - (if (null? pairs) - (raise-exception - (make-exception-with-message - "Concerning lack of friendship!")) - (if (equivalent-pair? pair pairs) - pair - (loop (car pairs) (cdr pairs)))))) - -(define (equivalent-pair? pair pairs) - "Given friendship pair PAIR and a list -of other PAIRS, determines if PAIR is -contained in PAIRS, irrespective of order" - (let ((r-pair (cons (cdr pair) - (car pair)))) - (any (lambda (pair) - (equal? r-pair pair)) - pairs))) - -(define (report->pairs str) - "Given a report, convert it to a -list of friendship pairs." - (let ((lst (string-split - (string-trim-both str char-set:whitespace) - char-set:whitespace))) - (map (lambda (str) - (return-friendship-pair - (string->number str))) - lst))) - -(define (return-friendship-pair num) - "Given NUM, returns a cons pair with -CAR as the original number and CDR as -the companion number." - (cons num (- 2020 num))) + get-2020-terms + includes-all? + generate-sets + make-complete-set)) + +(define (rr str len) + (apply * (get-2020-terms (map string->number + (string-split + (string-trim-both str char-set:whitespace) + char-set:whitespace)) + len))) + +(define (get-2020-terms lst len) + "Given a list of numbers, returns a list +of length LEN whose contents add up to 2020. + +Throws input-exception if none are found." + (let loop ((sets (generate-sets lst len))) + (cond + ((null? sets) (raise-exception + (make-exception-with-message + (format #f "Could not find ~s arguments that add to 2020 in inputs!" len)))) + ((includes-all? (car sets) lst) (car sets)) + (#t (loop (cdr sets)))))) + +(define (includes-all? lst1 lst2) + "Returns #t if all elements in LST1 +are present in LST2, #f otherwise." + (equal? lst1 + (lset-intersection eqv? lst1 lst2))) + +(define (generate-sets lst len) + (map make-complete-set (combinations lst (1- len)))) + +(define (make-complete-set lst) + "Given a LST of numbers, i.e. +'(979 366) +returns a list of one greater length +such that all numbers add up to 2020." + (append (list (- 2020 (apply + lst))) lst)) -- cgit v1.2.3