Fortran Implementation of Problem 76

View source code here on GitHub!

integer Problem0076/p0076()
 1! Project Euler Problem 76
 2!
 3! I ended up having to do this iteratively, which I'm not super happy with. I feel like there is almost certainly a
 4! closed-form solution to this, but I was unable to figure it out.
 5!
 6! Revision 1:
 7!
 8! Have counts store values instead of numeral counts to shave a few seconds off
 9!
10! Revision 2:
11!
12! Manually expand the sum loop in the preprocessor to try and get TCC output to be faster. Shaved a ~1/3 of runtime in
13! both CL and GCC in my initial testing.
14!
15! Revision 3:
16!
17! After testing on non-Windows systems, I found that Revision 2 royally borked it up. I reverted this, then applied an
18! optimization I found earlier today. The number of solutions to a + 2b + n = 100, where a, b, n in [0, 100] is
19! (100 - n) / 2 + 1. This brought runtime on TCC from ~3min -> ~1min and clang from ~6s -> ~2s. 
20!
21! Revision 4:
22!
23! Repeat an earlier optimization for the 2s case, so now it tries to keep the 2s value as close to the missing piece as
24! possible, cutting out a lot of useless loops. Runtime is approximately halved on TCC.
25!
26! Problem:
27!
28! It is possible to write five as a sum in exactly six different ways:
29!
30! 4 + 1
31! 3 + 2
32! 3 + 1 + 1
33! 2 + 2 + 1
34! 2 + 1 + 1 + 1
35! 1 + 1 + 1 + 1 + 1
36!
37! How many different ways can one hundred be written as a sum of at least two
38! positive integers?
39
40module Problem0076
41    use constants
42    implicit none
43contains
44    pure integer function p0076() result(answer)
45        integer :: idx, i, sum
46        integer, dimension(100) :: counts
47        answer = 0
48        counts = 0
49        counts(2) = 100
50        sum = 100
51        do while (counts(100) == 0)
52            counts(2) = counts(2) + 2
53            if (sum >= 100) then
54                answer = answer + (100 + counts(2) - sum) / 2
55                idx = 2
56                sum = 101  ! because no do-while loops
57                do while (sum > 100)
58                    counts(idx) = 0
59                    idx = idx + 1
60                    counts(idx) = counts(idx) + idx
61                    sum = counts(2)
62                    do i = 3, 99
63                        sum = sum + counts(i)
64                    end do
65                end do
66                counts(2) = 100 - sum - mod(sum, 2)
67            end if
68            sum = counts(2)
69            do i = 3, 99
70                sum = sum + counts(i)
71            end do
72        end do
73    end function p0076
74end module Problem0076

Tags: partition