My yearly advent-of-code solutions
treybastian.com
1module day_05_utils
2 implicit none
3contains
4 subroutine append_to_integer_array(arr, val)
5 implicit none
6 integer, allocatable, intent(inout) :: arr(:)
7 integer, intent(in) :: val
8 integer, allocatable :: temp(:)
9 if(.not. allocated(arr)) then
10 ERROR STOP 'Array not allocated'
11 end if
12 allocate(temp(size(arr) + 1))
13 temp(1:size(arr)) = arr
14 temp(size(arr) + 1) = val
15 call move_alloc(temp, arr)
16 end subroutine append_to_integer_array
17 function fix_and_get_middle_value(arr, left, right) result(res)
18 ! we are going to fix the array swapping until its right
19 ! there's probably a better way maybe? but I just want to get it done
20 implicit none
21 integer, allocatable, intent(in) :: arr(:), left(:), right(:)
22 integer, allocatable :: work(:), copy(:)
23 integer :: res, i, j, tmp
24 logical :: found
25 allocate(copy(size(arr)))
26 copy = arr
27 do
28 found = .false.
29 outer: do i = 1, size(copy)
30 if(i+1 < size(copy)) then ! if we can check forward
31 if(allocated(work)) then
32 deallocate(work)
33 end if
34 do j = 1, size(right) ! find value in right and save left to work
35 if (copy(i) == right(j)) then
36 if(.not. allocated(work)) then
37 allocate(work(1))
38 work(1) = left(j)
39 else
40 call append_to_integer_array(work, left(j))
41 end if
42 end if
43 end do
44 do j = i+1, size(copy)
45 if(any(work == copy(j))) then
46 tmp = copy(i)
47 copy(i) = copy(j)
48 copy(j) = tmp
49 found = .true.
50 exit outer
51 end if
52 end do
53 end if
54
55 if(.not. found) then ! if we are still valid lets keep going
56 if(allocated(work)) then
57 deallocate(work)
58 end if
59 if(i-1 > 0) then ! if we can check backwards
60 do j = 1, size(left) ! find value in left and save left to work
61
62 if (copy(i) == left(j)) then
63 if(.not. allocated(work)) then
64 allocate(work(1))
65 work(1) = right(j)
66 else
67 call append_to_integer_array(work, right(j))
68 end if
69 end if
70 end do
71 do j = 1, size(copy)
72 if(any(work == copy(j) .and. j < i)) then
73 tmp = copy(i)
74 copy(i) = copy(j)
75 copy(j) = tmp
76 found = .true.
77 exit outer
78 end if
79 end do
80 end if
81 else
82 exit outer
83 end if
84 end do outer
85 if(.not. found) exit
86 end do
87 res = copy((size(copy) + 1)/2)
88 deallocate(copy)
89 if(allocated(work)) then
90 deallocate(work)
91 end if
92 end function fix_and_get_middle_value
93end module day_05_utils
94program day_05
95 use day_05_utils
96 implicit none
97 integer :: io, ios, idx, a, b, ct, i, j, res, res_part2
98 integer, allocatable :: left(:), right(:), print_list(:), work(:)
99 character(len=100) ::line
100 logical :: found
101
102 open(newunit=io, file='./day_05_input.txt', status='old', action='read')
103 res = 0
104 res_part2 = 0
105 do
106 read(io, '(a)', iostat=ios) line
107 if(ios /= 0) exit !eof
108 idx = index(line, '|')
109 if(idx > 0) then ! rules
110 read(line(1:idx-1), *) a
111 read(line(idx+1:), *) b
112 if(.not. allocated(left)) then
113 allocate(left(1))
114 left(1) = a
115 else
116 call append_to_integer_array(left, a)
117 end if
118 if(.not. allocated(right)) then
119 allocate(right(1))
120 right(1) = b
121 else
122 call append_to_integer_array(right, b)
123 end if
124 end if
125 idx = index(line, ',')
126 if (idx > 0 ) then ! print_list
127 ct = 1
128 do i = 1 , len_trim(line)
129 if(line(i:i) == ',') then
130 ct = ct + 1
131 end if
132 end do
133 allocate(print_list(ct))
134 read(line, *) print_list
135 found = .false.
136 do i = 1, size(print_list)
137 if(i+1 < size(print_list)) then ! if we can check forward
138 do j = 1, size(right) ! find value in right and save left to work
139 if (print_list(i) == right(j)) then
140 if(.not. allocated(work)) then
141 allocate(work(1))
142 work(1) = left(j)
143 else
144 call append_to_integer_array(work, left(j))
145 end if
146 end if
147 end do
148 do j = 1, size(work)
149 if(any(print_list(i+1:size(print_list)) == work(j))) then
150 found = .true.
151 exit
152 end if
153 end do
154 deallocate(work)
155 end if
156 if(.not. found) then ! if we are still valid lets keep going
157 if(i-1 > 0) then ! if we can check backwards
158 do j = 1, size(left) ! find value in left and save left to work
159 if (print_list(i) == left(j)) then
160 if(.not. allocated(work)) then
161 allocate(work(1))
162 work(1) = right(j)
163 else
164 call append_to_integer_array(work, right(j))
165 end if
166 end if
167 end do
168 do j = 1, size(work)
169 if(any(print_list(1:i-1) == work(j))) then
170 found = .true.
171 exit
172 end if
173 end do
174 deallocate(work)
175 end if
176 else
177 exit
178 end if
179 end do
180 if (.not. found) then
181 res = res + print_list((size(print_list) + 1)/2)
182 else
183 res_part2 = res_part2 + fix_and_get_middle_value(print_list, left, right)
184 end if
185 deallocate(print_list)
186 end if
187 end do
188
189 deallocate(left)
190 deallocate(right)
191 print*, "Result ", res
192 print*, "Part 2 Result ", res_part2
193end program day_05