Quest 9: Encoded in the Scales

  • Keep top level comments as only solutions, if you want to say something other than a solution put it in a new post. (replies to comments can be whatever)
  • You can send code in code blocks by using three backticks, the code, and then three backticks or use something such as https://topaz.github.io/paste/ if you prefer sending it through a URL

Link to participate: https://everybody.codes/

  • vole@lemmy.world
    link
    fedilink
    English
    arrow-up
    2
    ·
    5 days ago

    Scheme/Guile

    I was stuck on part 3 for a while, for not taking account that a child scale that I’m evaluating may already be a parent scale in some group.

    (import (rnrs io ports (6))
            (srfi srfi-1))
    #!curly-infix
    
    (define (parse-file file-name)
      (let* ((lines (string-split (string-trim-both (call-with-input-file file-name get-string-all)) #\newline))
             (split-lines (map (lambda (l) (string-split l #\:)) lines))
             (parsed-lines (map (lambda (l) (cons (string->number (car l)) (string->list (cadr l)))) split-lines)))
        parsed-lines))
    
    (define (child-score child p1 p2 p1-sim p2-sim)
      (if (and-map null? (list child p1 p2))
          (* p1-sim p2-sim)
          (let ((matches-p1 (eq? (car child) (car p1)))
                (matches-p2 (eq? (car child) (car p2))))
            (cond
              ((not (or matches-p1 matches-p2)) #f)
              (else (child-score (cdr child) (cdr p1) (cdr p2) (+ p1-sim (if matches-p1 1 0)) (+ p2-sim (if matches-p2 1 0))))))))
    (let ((dna-lines (parse-file "notes/everybody_codes_e2025_q09_p1.txt")))
      (format #t "P1 Answer: ~a\n\n" (or
        (child-score (cdar dna-lines) (cdadr dna-lines) (cdaddr dna-lines) 0 0)
        (child-score (cdadr dna-lines) (cdar dna-lines) (cdaddr dna-lines) 0 0)
        (child-score (cdaddr dna-lines) (cdadr dna-lines) (cdar dna-lines) 0 0))))
    
    
    (let ((dna-lines (list->vector (parse-file "notes/everybody_codes_e2025_q09_p2.txt"))))
      (let loop ((child 0) (total-sim 0))
        (if {child < (vector-length dna-lines)}
            (loop (1+ child) (+ total-sim (let loop ((i 0))
              (cond
                ((eq? i child) (loop (1+ i)))
                ({i >= {(vector-length dna-lines) - 1}} 0)
                (else
                  (or
                    (let loop ((j (1+ i)))
                      (cond
                        ((eq? j child) (loop (1+ j)))
                        ({j >= (vector-length dna-lines)} #f)
                        (else (let ((res (child-score
                                   (cdr (vector-ref dna-lines child))
                                   (cdr (vector-ref dna-lines i))
                                   (cdr (vector-ref dna-lines j)) 0 0)))
                          (or res (loop (1+ j)))))))
                    (loop (1+ i))))))))
            (format #t "P2 Answer: ~a\n\n" total-sim))))
    
    
    (define (init-id-to-group dna-lines)
      (let ((table (make-hash-table)))
        (let loop ((i 0))
          (if {i < (vector-length dna-lines)}
              (let ((id (car (vector-ref dna-lines i))))
                (hash-set! table id id)
                (loop (1+ i)))
              table))))
    (define (init-group-to-ids dna-lines)
      (let ((table (make-hash-table)))
        (let loop ((i 0))
          (if {i < (vector-length dna-lines)}
              (let ((id (car (vector-ref dna-lines i))))
                (hash-set! table id (list id))
                (loop (1+ i)))
              table))))
    (let ((dna-lines (list->vector (parse-file "notes/everybody_codes_e2025_q09_p3.txt"))))
      (let ((id-to-group (init-id-to-group dna-lines)) (group-to-ids (init-group-to-ids dna-lines)))
      (let child-loop ((child 0))
        (if {child < (vector-length dna-lines)}
          (let i-loop ((i 0))
            (cond
              ((eq? i child) (i-loop (1+ i)))
              ({i >= {(vector-length dna-lines) - 1}} (child-loop (1+ child)))
              (else
                (let j-loop ((j (1+ i)))
                  (cond
                    ((eq? j child) (j-loop (1+ j)))
                    ({j >= (vector-length dna-lines)} (i-loop (1+ i)))
                    (else (let* ((cl (vector-ref dna-lines child))
                                 (pil (vector-ref dna-lines i))
                                 (pjl (vector-ref dna-lines j))
                                 (res (child-score (cdr cl) (cdr pil) (cdr pjl) 0 0)))
                      (if res
                          (let* ((i-group (hash-ref id-to-group (car pil)))
                                 (j-group (hash-ref id-to-group (car pjl)))
                                 (child-group (hash-ref id-to-group (car cl)))
                                 (i-group-ids (hash-ref group-to-ids i-group))
                                 (j-group-ids (hash-ref group-to-ids j-group))
                                 (child-group-ids (hash-ref group-to-ids child-group))
                                 (new-group-ids (delete-duplicates (append child-group-ids (or i-group-ids '()) (or j-group-ids '())))))
                            (map (lambda (id) (hash-set! id-to-group id child-group)) new-group-ids)
                            (hash-remove! group-to-ids i-group)
                            (hash-remove! group-to-ids j-group)
                            (hash-set! group-to-ids child-group new-group-ids)
                            (child-loop (1+ child)))
                          (j-loop (1+ j))))))))))
            (format #t "P3 Answer: ~a\n\n" (cdr (hash-fold
                    (lambda (_ id-list prior)
                            (let ((group-size (length id-list))
                                  (group-sum (apply + id-list)))
                              (if {group-size > (car prior)}
                                  (cons group-size group-sum)
                                  prior)))
                    (cons 0 0)
                    group-to-ids)))))))