Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- PROGRAM DAY10
- INTEGER :: I,J,K,IERR,NROWS,NCOLS,NOBJS,LASER,LASERLOC(2),PART2(2),DESTROYED
- CHARACTER(LEN=1) :: CHAR
- CHARACTER(LEN=1),ALLOCATABLE :: MAP(:,:)
- CHARACTER(LEN=:),ALLOCATABLE :: LINE
- INTEGER, ALLOCATABLE :: LOCATIONS(:,:),ORDER(:)
- REAL,ALLOCATABLE :: DIRECTIONS(:)
- LOGICAL, ALLOCATABLE :: SEEN(:,:),SHOT(:)
- INTEGER :: HOURS_OF_WASTED_TIME(2)
- OPEN(1,FILE="input.txt")
- NCOLS=0
- DO
- READ(1,'(A)',ADVANCE="NO",IOSTAT=IERR)CHAR
- IF(IERR.NE.0)EXIT
- NCOLS=NCOLS+1
- END DO
- REWIND(1)
- NROWS=0
- DO
- READ(1,*,IOSTAT=IERR)
- IF(IERR.NE.0)EXIT
- NROWS=NROWS+1
- END DO
- REWIND(1)
- ALLOCATE(CHARACTER(LEN=NCOLS) :: LINE)
- ALLOCATE(MAP(NCOLS,NROWS))
- DO I=1,NROWS
- READ(1,*)LINE
- DO J=1,NCOLS
- MAP(J,I)=LINE(J:J)
- END DO
- END DO
- CLOSE(1)
- NOBJS=COUNT(MAP.EQ."#")
- ALLOCATE(LOCATIONS(2,NOBJS),SEEN(NOBJS,NOBJS))
- K=1
- DO J=1,NROWS
- DO I=1,NROWS
- IF(MAP(I,J).EQ."#")THEN
- LOCATIONS(:,K)=(/I,J/)
- K=K+1
- END IF
- END DO
- END DO
- SEEN=.FALSE.
- DO I=1,NOBJS-1
- DO J=I+1,NOBJS
- SEEN(I,J)=CANSEE(LOCATIONS(:,I),LOCATIONS(:,J))
- SEEN(J,I)=SEEN(I,J)
- END DO
- END DO
- WRITE(*,'("Part 1: ",I0)') MAXVAL((/(COUNT(SEEN(:,I)),I=1,NOBJS)/))
- LASER=MAXLOC((/(COUNT(SEEN(:,I)),I=1,NOBJS)/),DIM=1)
- LASERLOC=LOCATIONS(:,LASER)
- ALLOCATE(DIRECTIONS(NOBJS),SHOT(NOBJS),ORDER(NOBJS))
- SHOT=.FALSE.
- SHOT(LASER)=.TRUE.
- DO I=1,NOBJS
- IF(I.EQ.LASER)CYCLE
- DIRECTIONS(I)=GETDIR(LASERLOC,LOCATIONS(:,I))
- END DO
- ORDER=SORTORDER(DIRECTIONS)
- DESTROYED=0
- OUTER:DO
- DO I=1,NOBJS
- IF(SHOT(ORDER(I)))CYCLE
- IF(CANSEE(LASERLOC,LOCATIONS(:,ORDER(I))))THEN
- SHOT(ORDER(I))=.TRUE.
- DESTROYED=DESTROYED+1
- IF(DESTROYED.EQ.200)THEN
- PART2=LOCATIONS(:,ORDER(I))
- EXIT OUTER
- END IF
- END IF
- END DO
- DO I=1,NOBJS
- IF(SHOT(ORDER(I)))THEN
- MAP(LOCATIONS(1,ORDER(I)),LOCATIONS(2,ORDER(I)))="X"
- END IF
- END DO
- END DO OUTER
- HOURS_OF_WASTED_TIME = (/-1,-1/)
- WRITE(*,'("Part 2: ",I0,I2.2)')PART2+HOURS_OF_WASTED_TIME
- CONTAINS
- FUNCTION GETDIR(LOC1,LOC2) RESULT(RES)
- INTEGER :: LOC1(2),LOC2(2)
- REAL :: RES
- RES= ATAN2(REAL(LOC2(1)-LOC1(1)),REAL(LOC1(2)-LOC2(2)))
- IF(RES.LT.0)RES=RES+8*ATAN(1.0)
- END FUNCTION GETDIR
- FUNCTION SORTORDER(ARRAY) RESULT(ORDER)
- REAL :: ARRAY(:),NEXT
- INTEGER :: ORDER(SIZE(ARRAY,DIM=1)),I,J
- J=1
- NEXT=MINVAL(ARRAY)-1
- DO
- IF(J>SIZE(ARRAY))EXIT
- NEXT=MINVAL(ARRAY,MASK=ARRAY.GT.NEXT)
- DO I=1,SIZE(ARRAY)
- IF(ARRAY(I).EQ.NEXT)THEN
- ORDER(J)=I
- J=J+1
- END IF
- END DO
- END DO
- END FUNCTION SORTORDER
- FUNCTION CANSEE(LOC1,LOC2) RESULT(RES)
- INTEGER :: LOC1(2),LOC2(2)
- LOGICAL :: RES
- INTEGER X,Y,XDIR,YDIR,DIV
- RES=.FALSE.
- XDIR=LOC2(1)-LOC1(1)
- YDIR=LOC2(2)-LOC1(2)
- IF(XDIR.EQ.0)THEN
- YDIR=ABS(YDIR)/YDIR
- ELSEIF(YDIR.EQ.0)THEN
- XDIR=ABS(XDIR)/XDIR
- ELSE
- DIV=LCD(ABS(XDIR),ABS(YDIR))
- XDIR=XDIR/DIV
- YDIR=YDIR/DIV
- END IF
- X=LOC1(1)+XDIR
- Y=LOC1(2)+YDIR
- DO
- IF(MAP(X,Y).EQ."#")THEN
- IF(ALL(LOC2.EQ.(/X,Y/)))RES=.TRUE.
- EXIT
- END IF
- X=X+XDIR
- Y=Y+YDIR
- END DO
- END FUNCTION CANSEE
- FUNCTION LCD(A,B) RESULT(RES)
- INTEGER :: A,B,C,D,RES
- C=A
- D=B
- DO
- IF(C.EQ.D)EXIT
- IF(C.GT.D)THEN
- C=C-D
- ELSE
- D=D-C
- END IF
- END DO
- RES=C
- END FUNCTION LCD
- END PROGRAM DAY10
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement