autid

AoC 2021 Day8 FORTRAN

Dec 8th, 2021
952
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. PROGRAM DAY8
  2.     IMPLICIT NONE
  3.     INTEGER :: IERR,P1=0,P2=0
  4.     CHARACTER(LEN=9) :: A(15)
  5.  
  6.     OPEN(1,FILE="input.txt")
  7.     DO
  8.         READ(1,*,IOSTAT=IERR) A
  9.         IF(IERR.NE.0) EXIT
  10.         P1=P1+COUNT(LEN_TRIM(A(12:15)).EQ.2)
  11.         P1=P1+COUNT(LEN_TRIM(A(12:15)).EQ.4)
  12.         P1=P1+COUNT(LEN_TRIM(A(12:15)).EQ.3)
  13.         P1=P1+COUNT(LEN_TRIM(A(12:15)).EQ.7)
  14.         P2=P2+DECODE((/ A(1:10), A(12:15) /))
  15.     END DO
  16.     CLOSE(1)
  17.  
  18.     WRITE(*,'(A,I0)') "Part 1: ", P1
  19.     WRITE(*,'(A,I0)') "Part 2: ", P2
  20. CONTAINS
  21.     FUNCTION DECODE(IN) RESULT(TOTAL)
  22.         CHARACTER(LEN=9) :: IN(14)
  23.         LOGICAL :: MAPS(IACHAR("a"):IACHAR("g"),7),SAV(7),DGT(7)
  24.         INTEGER :: I,J,K, TOTAL
  25.         INTEGER :: TENS(4) = (/1000,100,10,1/), DIGITS(11:14)
  26.  
  27.         MAPS = .TRUE.
  28.         DO I=1,14
  29.             IF(LEN_TRIM(IN(I)).EQ.2) THEN
  30.                 DO J=1,2
  31.                     K=IACHAR(IN(I)(J:J))
  32.                     SAV=MAPS(K,:)
  33.                     MAPS(K,:) = .FALSE.
  34.                     MAPS(K,3) = SAV(3)
  35.                     MAPS(K,6) = SAV(6)
  36.                 END DO
  37.             ELSE IF(LEN_TRIM(IN(I)).EQ.3) THEN
  38.                 DO J=1,3
  39.                     K=IACHAR(IN(I)(J:J))
  40.                     SAV=MAPS(K,:)
  41.                     MAPS(K,:) = .FALSE.
  42.                     MAPS(K,1) = SAV(1)
  43.                     MAPS(K,3) = SAV(3)
  44.                     MAPS(K,6) = SAV(6)
  45.                 END DO
  46.             ELSE IF(LEN_TRIM(IN(I)).EQ.4) THEN
  47.                 DO J=1,4
  48.                     K=IACHAR(IN(I)(J:J))
  49.                     SAV=MAPS(K,:)
  50.                     MAPS(K,:) = .FALSE.
  51.                     MAPS(K,2) = SAV(2)
  52.                     MAPS(K,3) = SAV(3)
  53.                     MAPS(K,4) = SAV(4)
  54.                     MAPS(K,6) = SAV(6)
  55.                 END DO
  56.             ELSE IF(LEN_TRIM(IN(I)).EQ.5) THEN
  57.                 DO K=IACHAR("a"),IACHAR("g")
  58.                     IF(SCAN(IN(I),ACHAR(K)).EQ.0) THEN
  59.                         SAV=MAPS(K,:)
  60.                         MAPS(K,:) = .FALSE.
  61.                         MAPS(K,2) = SAV(2)
  62.                         MAPS(K,3) = SAV(3)
  63.                         MAPS(K,5) = SAV(5)
  64.                         MAPS(K,6) = SAV(6)
  65.                     END IF
  66.                 END DO
  67.             ELSE IF(LEN_TRIM(IN(I)).EQ.6) THEN
  68.                 DO K=IACHAR("a"),IACHAR("g")
  69.                     IF(SCAN(IN(I),ACHAR(K)).EQ.0) THEN
  70.                         SAV=MAPS(K,:)
  71.                         MAPS(K,:) = .FALSE.
  72.                         MAPS(K,3) = SAV(3)
  73.                         MAPS(K,4) = SAV(4)
  74.                         MAPS(K,5) = SAV(5)
  75.                     END IF
  76.                 END DO
  77.             END IF
  78.             DO J=IACHAR("a"),IACHAR("g")
  79.                 DO K=1,7
  80.                     IF(MAPS(J,K)) THEN
  81.                         IF(COUNT(MAPS(J,:)).EQ.1 .OR. COUNT(MAPS(:,K)).EQ.1) THEN
  82.                             MAPS(J,:) = .FALSE.
  83.                             MAPS(:,K) = .FALSE.
  84.                             MAPS(J,K) = .TRUE.
  85.                         END IF
  86.                     END IF
  87.                 END DO
  88.             END DO
  89.             IF(COUNT(MAPS).EQ.7) EXIT
  90.         END DO
  91.         DO I=11,14
  92.             DGT=.FALSE.
  93.             K=8
  94.             DO J=1,LEN_TRIM(IN(I))
  95.                 DGT=DGT.OR.MAPS(IACHAR(IN(I)(J:J)),:)
  96.             END DO
  97.             SELECT CASE (COUNT(DGT))
  98.             CASE (2)
  99.                 K=1
  100.             CASE (3)
  101.                 K=7
  102.             CASE (4)
  103.                 K=4
  104.             CASE (5)
  105.                 IF(DGT(3).AND.DGT(6))K=3
  106.                 IF(DGT(2)) K=5
  107.                 IF(DGT(5)) K=2
  108.             CASE(6)
  109.                 IF(.NOT.DGT(4)) K=0
  110.                 IF(.NOT.DGT(3)) K=6
  111.                 IF(.NOT.DGT(5)) K=9
  112.             END SELECT
  113.             DIGITS(I) = K
  114.         END DO
  115.         TOTAL=SUM(TENS*DIGITS)
  116.  
  117.     END FUNCTION DECODE
  118.  
  119. END PROGRAM DAY8
RAW Paste Data