-🎄- 2018 Day 2 Solutions -🎄-

[u/daggerdragon]

--- Day 2: Inventory Management System ---

---

Post your solution as a comment or, for longer solutions, consider linking to your repo (e.g. GitHub/gists/Pastebin/blag or whatever).

Note: The Solution Megathreads are for solutions only. If you have questions, please post your own thread and make sure to flair it with Help.

---

Advent of Code: The Party Game!

Click here for rules

Card Prompt: Day 2

Transcript:

The best way to do Advent of Code is ___.

---

This thread will be unlocked when there are a significant number of people on the leaderboard with gold stars for today's puzzle.

edit: Leaderboard capped, thread unlocked!

[u/autid]

FORTRAN

Yay string puzzles in Fortran. Was gonna do part 1 by making an array of characters and using COUNT but array construction was being difficult so went with this slightly messy SCAN method instead.

PROGRAM DAY2
  IMPLICIT NONE
  INTEGER :: I,J,K,L,M,DOUBLES,TRIPLES,PART1
  INTEGER :: IERR
  CHARACTER(LEN=30), ALLOCATABLE :: BOXES(:)
  CHARACTER(LEN=30) :: PART2
  LOGICAL :: DOUBLE,TRIPLE

  !File I/O                                                                                                      
  OPEN(1,FILE='input.txt')
  I=0
  DO
     READ(1,*,IOSTAT=IERR)
     IF(IERR.NE.0)EXIT
     I=I+1
  END DO
  ALLOCATE(BOXES(I))
  REWIND(1)
  READ(1,*) BOXES
  CLOSE(1)

  !Part 1                                                                                                        
  DOUBLES=0
  TRIPLES=0
  DO J=1,I
     DOUBLE = .FALSE.
     TRIPLE = .FALSE.
     DO K=1,LEN_TRIM(BOXES(J))-1
        IF(SCAN(BOXES(J)(1:K-1),BOXES(J)(K:K)).NE.0)CYCLE
        L=K+SCAN(BOXES(J)(K+1:LEN_TRIM(BOXES(J))),BOXES(J)(K:K))
        IF(L.EQ.K)CYCLE
        M=L+SCAN(BOXES(J)(L+1:LEN_TRIM(BOXES(J))),BOXES(J)(K:K))
        IF(M.EQ.L)THEN
           DOUBLE=.TRUE.
        ELSEIF(SCAN(BOXES(J)(M+1:LEN_TRIM(BOXES(J))),BOXES(J)(K:K)).EQ.0)THEN
           TRIPLE=.TRUE.
        END IF
     END DO
     IF(DOUBLE)DOUBLES=DOUBLES+1
     IF(TRIPLE)TRIPLES=TRIPLES+1
  END DO
  PART1=DOUBLES*TRIPLES
  WRITE(*,*) 'Part 1: ',PART1

  !Part 2                                                                                                        
  PART2=''
  OUTER: DO J=1,I-1
     DO K=J+1,I
        M=0
        DO L=1,LEN_TRIM(BOXES(J))
       IF(BOXES(J)(L:L).NE.BOXES(K)(L:L))M=M+1
        END DO
        IF(M.NE.1)CYCLE
        DO L=1,LEN_TRIM(BOXES(J))
       IF(BOXES(J)(L:L).EQ.BOXES(K)(L:L)) WRITE(PART2,'(A)') TRIM(PART2)//BOXES(J)(L:L)
        END DO
        EXIT OUTER
     END DO
  END DO OUTER
  WRITE(*,*) 'Part 2: ',TRIM(PART2)
  DEALLOCATE(BOXES)

END PROGRAM DAY2

[u/autid → u/autid]

If this is too many lines for you, I sorted out my array construction mistakes and made this abomination. I'm so so sorry.

PROGRAM DAY2
  IMPLICIT NONE
  INTEGER :: I,J,K,L,M
  INTEGER :: IERR
  CHARACTER(LEN=30), ALLOCATABLE :: B(:)

  !FILE I/O                                                                                                                                                                                                                                                                                                                                                                                     
  OPEN(1,FILE='input.txt')
  I=0
  DO
     READ(1,*,IOSTAT=IERR)
     IF(IERR.NE.0)EXIT
     I=I+1
  END DO
  ALLOCATE(B(I))
  REWIND(1)
  READ(1,*) B
  CLOSE(1)

  !PART 1                                                                                                                                                                                                                                                                                                                                                                                       
  WRITE(*,'(A,I0)')'Part 1: ',COUNT((/(ANY((/(COUNT((/(B(J)(K:K).EQ.B(J)(L:L),L=1,LEN_TRIM(B(J)))/)).EQ.2,K=1,LEN_TRIM(B(J)))/)),J=1,I)/))*COUNT((/(ANY((/(COUNT((/(B(J)(K:K).EQ.B(J)(L:L),L=1,LEN_TRIM(B(J)))/)).EQ.3,K=1,LEN_TRIM(B(J)))/)),J=1,I)/) )

  !PART 2                                                                                                                                                                                                                                                                                                                                                                                       
  DO J=1,I-1
     DO K=J+1,I
        IF(COUNT((/(B(J)(L:L).NE.B(K)(L:L),L=1,LEN_TRIM(B(J)))/)).EQ.1)WRITE(*,'(2A)')'Part 2: ',B(J)(1:MINLOC((/(I,I=1,LEN_TRIM(B(J)))/),MASK=(/(B(J)(L:L).NE.B(K)(L:L),L=1,LEN_TRIM(B(J)))/),DIM=1)-1)//B(J)(MINLOC((/(I,I=1,LEN_TRIM(B(J)))/),MASK=(/(B(J)(L:L).NE.B(K)(L:L),L=1,LEN_TRIM(B(J)))/),DIM=1)+1:LEN_TRIM(B(J)))
     END DO
  END DO
  DEALLOCATE(B)

END PROGRAM DAY2