My yearly advent-of-code solutions
1module day_09_utils 2 implicit none 3contains 4 subroutine swap_to_first_positive_integer_from_end(arr, idx) 5 implicit none 6 integer, allocatable, intent(inout) :: arr(:) 7 integer, intent(in) :: idx 8 integer, allocatable :: temp(:) 9 integer :: i, res 10 do i = 0, size(arr) - 1 11 if(arr(size(arr) - i) > -1) then 12 arr(idx) = arr(size(arr) - i) 13 allocate(temp(size(arr) - (i +1))) 14 temp = arr(1:size(arr) - (i+1)) 15 call move_alloc(temp, arr) 16 return 17 end if 18 end do 19 end subroutine swap_to_first_positive_integer_from_end 20 subroutine append_to_integer_array_times(arr, val, times) 21 implicit none 22 integer, allocatable, intent(inout) :: arr(:) 23 integer, intent(in) :: val, times 24 integer, allocatable :: temp(:) 25 if(.not. allocated(arr)) then 26 ERROR STOP 'Array not allocated' 27 end if 28 allocate(temp(size(arr) + times)) 29 temp(1:size(arr)) = arr 30 temp(size(arr) + 1:size(temp)) = val 31 call move_alloc(temp, arr) 32 end subroutine append_to_integer_array_times 33end module day_09_utils 34program day_09 35 use iso_fortran_env, only: int64 36 use day_09_utils 37 implicit none 38 integer :: io, ios, i, j, block_n, ct, block_start, block_end, space_start, space_end 39 integer(kind=int64) :: res 40 character(len=1) :: c 41 integer, allocatable :: system(:), work(:), done(:) 42 logical :: is_space, space_block_start 43 44 open(newunit=io, file='./day_09_input.txt', status='old', action='read', access='stream') 45 is_space = .false. 46 block_n = 0 47 do 48 read(io, iostat=ios) c 49 if (ios /= 0) exit 50 read(c, *, iostat=ios) i 51 if(ios /= 0) exit 52 if (i == 0) then 53 is_space = .false. 54 cycle 55 end if 56 if (.not. allocated(system)) then 57 allocate(system(i)) 58 system(1:i) = block_n 59 is_space = .true. 60 block_n = block_n + 1 61 else 62 if (is_space) then 63 call append_to_integer_array_times(system, -1, i) 64 is_space = .false. 65 else 66 call append_to_integer_array_times(system, block_n, i) 67 block_n = block_n + 1 68 is_space = .true. 69 end if 70 end if 71 end do 72 allocate(work(size(system))) 73 work = system 74 ct = count(work > -1) 75 outer: do 76 do i = 1, size(work) 77 if (i == ct) exit outer ! we are done 78 if(work(i) < 0) then 79 call swap_to_first_positive_integer_from_end(work, i) 80 exit 81 end if 82 end do 83 end do outer 84 res = 0 85 do i = 1, size(work) 86 if(work(i) > -1) then 87 res = res + ((i-1) * work(i)) 88 else 89 end if 90 end do 91 print *, res 92 ! start_part_2 93 res = 0 94 deallocate(work) 95 allocate(work(size(system))) 96 work = system 97 block_n = -1 98 block_start = -1 99 block_end = -1 100 do i = size(work), 1, -1 101 if(block_n == -1 .and. work(i) /= -1) then 102 ! we are starting a block 103 block_end = i 104 block_n = work(i) 105 if(allocated(done) .and. count(done == block_n) > 0) then 106 block_n = -1 107 block_start = -1 108 block_end = -1 109 cycle 110 else if(.not. allocated(done)) then 111 allocate(done(1)) 112 done(1) = block_n 113 else 114 call append_to_integer_array_times(done, block_n, 1) 115 end if 116 else if (block_n /= -1 .and. block_n /= work(i)) then 117 ! we are ending the block 118 block_start = i 119 120 ! lets try to move the block 121 space_block_start = .true. 122 do j = 1, size(work) 123 if (j > block_start) exit 124 if(space_block_start .and. work(j) == -1) then 125 space_start = j 126 space_block_start = .false. 127 else if (.not. space_block_start .and. work(j) /= -1) then 128 space_end = j 129 space_block_start = .true. 130 if(space_end - space_start >= block_end - block_start) then 131 work(space_start:space_start + (block_end - (block_start +1))) = block_n 132 work(block_start+1:block_end) = -1 133 exit 134 end if 135 space_end = -1 136 space_start = -1 137 end if 138 end do 139 block_n = work(i) 140 block_end = i 141 block_start = -1 142 end if 143 end do 144 do i = 1, size(work) 145 if(work(i) /= -1) then 146 res = res + ((i-1) * work(i)) 147 end if 148 end do 149 print *, res 150end program day_09 151 152