<commit_before>(import (use "eg/advent-of-code/utils")
  grammar<- parson-parse count)

;(let input (with-input-file '.read-all "eg/advent-of-code/18/data/advent16.test"))
(let input (with-input-file '.read-all "eg/advent-of-code/18/data/advent16"))

(let grammar (grammar<- "
main: clause* :hug '\n\n' program.  # N.B. no :end
clause: 'Before: [' [:nat ', ' :nat ', ' :nat ', ' :nat :hug] ']\n'
        [:nat ' ' :nat ' ' :nat ' ' :nat :hug] '\n'
        'After:  [' [:nat ', ' :nat ', ' :nat ', ' :nat :hug] ']\n\n' :hug.

program: insn* :hug.
insn:    :nat ' ' :nat ' ' :nat ' ' :nat '\n' :hug.
"))
(let semantics (grammar (map<-)))
(let parse-main (semantics 'main))
(to (parse string)
  ('.results (parson-parse parse-main string)))

(let `(,observations ,program) (parse input))
(each! print program)
(format "#obs: ~w\n" observations.count)


(display "\nPart 1\n")

(to (run program assignments)
  (let regs (array<-count 4 0))
  (let vm (vm<- regs))
  (for each! ((`(,opcode ,a ,b ,c) program))
    (vm .do (assignments opcode) a b c))
  regs)

(to (vm<- regs)
  (make vm
    ({.do op a b c}
     (let result
       (match op

         ('addr  (+ (regs a) (regs b)))
         ('addi  (+ (regs a) b))

         ('mulr  (* (regs a) (regs b)))
         ('muli  (* (regs a) b))

         ('banr  ((regs a) .and (regs b)))
         ('bani  ((regs a) .and b))
       
         ('borr  ((regs a) .or (regs b)))
         ('bori  ((regs a) .or b))
       
         ('setr  (regs a))
         ('seti  a)
       
         ; TODO I'm not sure about this method name claim.count
         ('gtir  ('.count (> a (regs b))))
         ('gtri  ('.count (> (regs a) b)))
         ('gtrr  ('.count (> (regs a) (regs b))))
       
         ('eqir  ('.count (= a (regs b))))
         ('eqri  ('.count (= (regs a) b)))
         ('eqrr  ('.count (= (regs a) (regs b))))
       
         ))
     (regs .set! c result))

    ({.get-regs} regs)
    ))

(let all-op-names
  '(addr addi mulr muli
    banr bani borr bori
    setr seti
    gtir gtri gtrr eqir eqri eqrr))

(let constraints
  (for each ((sample observations))
    (let `(,regs-pre (,op ,a ,b ,c) ,regs-post) sample)
    (let compatible-ops
      (for filter ((op-name all-op-names))
        (let vm (vm<- (array<-list regs-pre)))
        (vm .do op-name a b c)
        (and (= regs-post (as-list vm.get-regs))
             op-name)))
;;    (format "~w: ~w\n" op (sort compatible-ops))
    `(,op ,compatible-ops)))

(to (part-1)
  (for count ((`(,_ ,compatible-ops) constraints))
    (<= 3 compatible-ops.count)))

;(format "~w\n" (part-1))


(display "\nPart 2\n")

(to (part-2)
  ;; TODO: map-reduce with intersection
  (let op-name-set (call set<- all-op-names))
  (let opcodes (call set<- (each '.first constraints)))
  (let candidates (map<- (for each ((opcode opcodes.keys))
                           `(,opcode ,op-name-set))))
  (for each! ((`(,opcode ,op-names) constraints))
    (let set (candidates opcode))
    (candidates .set! opcode (set .intersect (call set<- op-names))))

  ;; Trivial constraint satisfaction turns out to be good enough:
  (let assignments (map<-))
  (begin pruning ()
    (let opcode (min-by (compose '.count candidates)
                        candidates.keys))
    (when (= 1 ('.count (candidates opcode)))
      (let op-name (((candidates opcode) .keys) .first)) ;clumsy
      (assignments .set! opcode op-name)
      (candidates .delete! opcode)
      (for each! ((`(,op2 ,names2) candidates.items))
        (candidates .set! op2 (names2 .difference (set<- op-name)))) ;XXX missing .delete!
      (unless candidates.empty?
        (pruning))))
  (surely candidates.empty?)

  (each! print assignments.items)
  (newline)

  (let post-regs (run program assignments))
  (post-regs 0))

(format "~w\n" (part-2))
<commit_msg>tweak<commit_after>(import (use "eg/advent-of-code/utils")
  grammar<- parson-parse count)

;(let input (with-input-file '.read-all "eg/advent-of-code/18/data/advent16.test"))
(let input (with-input-file '.read-all "eg/advent-of-code/18/data/advent16"))

(let grammar (grammar<- "
main: clause* :hug '\n\n' program.  # N.B. no :end
clause: 'Before: [' [:nat ', ' :nat ', ' :nat ', ' :nat :hug] ']\n'
        [:nat ' ' :nat ' ' :nat ' ' :nat :hug] '\n'
        'After:  [' [:nat ', ' :nat ', ' :nat ', ' :nat :hug] ']\n\n' :hug.

program: insn* :hug.
insn:    :nat ' ' :nat ' ' :nat ' ' :nat '\n' :hug.
"))
(let semantics (grammar (map<-)))
(let parse-main (semantics 'main))
(to (parse string)
  ('.results (parson-parse parse-main string)))

(let `(,observations ,program) (parse input))
;(each! print program)
(format "#obs: ~w\n" observations.count)


(display "\nPart 1\n")

(to (run program assignments)
  (let regs (array<-count 4 0))
  (let vm (vm<- regs))
  (for each! ((`(,opcode ,a ,b ,c) program))
    (vm .do (assignments opcode) a b c))
  regs)

(to (vm<- regs)
  (make vm
    ({.do op a b c}
     (let result
       (match op

         ('addr  (+ (regs a) (regs b)))
         ('addi  (+ (regs a) b))

         ('mulr  (* (regs a) (regs b)))
         ('muli  (* (regs a) b))

         ('banr  ((regs a) .and (regs b)))
         ('bani  ((regs a) .and b))
       
         ('borr  ((regs a) .or (regs b)))
         ('bori  ((regs a) .or b))
       
         ('setr  (regs a))
         ('seti  a)
       
         ; TODO I'm not sure about this method name claim.count
         ('gtir  ('.count (> a (regs b))))
         ('gtri  ('.count (> (regs a) b)))
         ('gtrr  ('.count (> (regs a) (regs b))))
       
         ('eqir  ('.count (= a (regs b))))
         ('eqri  ('.count (= (regs a) b)))
         ('eqrr  ('.count (= (regs a) (regs b))))
       
         ))
     (regs .set! c result))

    ({.get-regs} regs)
    ))

(let all-op-names
  '(addr addi mulr muli
    banr bani borr bori
    setr seti
    gtir gtri gtrr eqir eqri eqrr))

(let constraints
  (for each ((sample observations))
    (let `(,regs-pre (,op ,a ,b ,c) ,regs-post) sample)
    (let compatible-ops
      (for filter ((op-name all-op-names))
        (let vm (vm<- (array<-list regs-pre)))
        (vm .do op-name a b c)
        (and (<=> regs-post vm.get-regs)
             op-name)))
;;    (format "~w: ~w\n" op (sort compatible-ops))
    `(,op ,compatible-ops)))

(to (part-1)
  (for count ((`(,_ ,compatible-ops) constraints))
    (<= 3 compatible-ops.count)))

;(format "~w\n" (part-1))


(display "\nPart 2\n")

(to (part-2)
  ;; TODO: map-reduce with intersection
  (let op-name-set (call set<- all-op-names))
  (let opcodes (call set<- (each '.first constraints)))
  (let candidates (map<- (for each ((opcode opcodes.keys))
                           `(,opcode ,op-name-set))))
  (for each! ((`(,opcode ,op-names) constraints))
    (let set (candidates opcode))
    (candidates .set! opcode (set .intersect (call set<- op-names))))

  ;; Trivial constraint satisfaction turns out to be good enough:
  (let assignments (map<-))
  (begin pruning ()
    (let opcode (min-by (compose '.count candidates)
                        candidates.keys))
    (when (= 1 ('.count (candidates opcode)))
      (let op-name (((candidates opcode) .keys) .first)) ;clumsy
      (assignments .set! opcode op-name)
      (candidates .delete! opcode)
      (for each! ((`(,op2 ,names2) candidates.items))
        (candidates .set! op2 (names2 .difference (set<- op-name)))) ;XXX missing .delete!
      (unless candidates.empty?
        (pruning))))
  (surely candidates.empty?)

  (each! print assignments.items)
  (newline)

  (let post-regs (run program assignments))
  (post-regs 0))

(format "~w\n" (part-2))

{'fraction_non_alphanumeric': 0.19886737784801792, 'fraction_numerical': 0.00605821151060187, 'mean_word_length': 2.3468488320846186, 'pattern_counts': {'":': 0, '<': 34, '<?xml version=': 0, '>': 10, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1178278', 'n_tokens_mistral': 2908, 'n_tokens_neox': 2769, 'n_words': 833}