5
\$\begingroup\$

I decided to write a function divisorSum that sums the divisors of number. For instance 1, 2, 3 and 6 divide 6 evenly so:

$$ \sigma(6) = 1 + 2 + 3 + 6= 12 $$

I decided to use Euler's recurrence relation to calculate the sum of divisors:

$$\sigma(n) = \sigma(n-1) + \sigma(n-2) - \sigma(n-5) - \sigma(n-7) + \sigma(n-12) +\sigma(n-15) + \ldots$$

i.e.

$$\sigma(n) = \sum_{i\in \mathbb Z_0} (-1)^{i+1}\left( \sigma\left(n - \tfrac{3i^2-i}{2}\right) + \delta\left(n,\tfrac{3i^2-i}{2}\right)n \right)$$

(See here for the details). As such, I decided to export some other useful functions like nthPentagonal which returns the nth (generalized) pentagonal number. I created a new project with stack new and modified these two files:

src/Lib.hs

module Lib
    ( nthPentagonal,
      pentagonals,
      divisorSum,
    ) where

-- | Creates a [generalized pentagonal integer]
-- | (https://en.wikipedia.org/wiki/Pentagonal_number_theorem) integer.
nthPentagonal :: Integer -> Integer
nthPentagonal n = n * (3 * n - 1) `div` 2

-- | Creates a lazy list of all the pentagonal numbers.
pentagonals :: [Integer]
pentagonals = map nthPentagonal integerStream

-- | Provides a stream for representing a bijection from naturals to integers
-- | i.e. [1, -1, 2, -2, ... ].
integerStream :: [Integer]
integerStream = map integerOrdering [1 .. ]
    where
    integerOrdering :: Integer -> Integer
    integerOrdering n
        | n `rem` 2 == 0 = (n `div` 2) * (-1)
        | otherwise = (n `div` 2) + 1

-- | Using Euler's formula for the divisor function, we see that each summand
-- | alternates between two positive and two negative. This provides a stream
-- | of 1 1 -1 -1 1 1 ... to utilze in assiting this property.
additiveStream :: [Integer]
additiveStream = map summandSign [0 .. ]
    where
    summandSign :: Integer -> Integer
    summandSign n
        | n `rem` 4 >= 2 = -1
        | otherwise = 1

-- | Kronkecker delta, return 0 if the integers are not the same, otherwise,
-- | return the value of the integer.
delta :: Integer -> Integer -> Integer
delta n i
    | n == i = n
    | otherwise = 0

-- | Calculate the sum of the divisors.
-- | Utilizes Euler's recurrence formula:
-- | $\sigma(n) = \sigma(n - 1) + \sigma(n - 2) - \sigma(n - 5) \ldots $
-- | See [here](https://math.stackexchange.com/a/22744/15140) for more informa-
-- | tion.
divisorSum :: Integer -> Integer
divisorSum n
    | n <= 0 = 0
    | otherwise = sum $ takeWhile (/= 0)
                                  (zipWith (+)
                                           (divisorStream n)
                                           (markPentagonal n))
    where
    pentDual :: Integer -> [Integer]
    pentDual n = [ n - x | x <- pentagonals]
    divisorStream :: Integer -> [Integer]
    divisorStream n = zipWith (*)
                              (map divisorSum (pentDual n))
                              additiveStream
    markPentagonal :: Integer -> [Integer]
    markPentagonal n = zipWith (*)
                               (zipWith (delta) 
                                        pentagonals
                                        (repeat n))
                               additiveStream

app/Main.hs (mostly just to "test" it.)

module Main where

import Lib

main :: IO ()
main = putStrLn $ show $ divisorSum 8
\$\endgroup\$
4
\$\begingroup\$

TL;DR:

  • use memoization to speed up calculations
  • if you drive for performance use quot instead of div
  • if possible, try to define your sequences without complicated functions
  • use even n instead of n `rem` 2 == 0 or odd n instead of n `rem` 2 == 1

Type annotations and documentation

You use both type annotations as well as documentation. Great. There are only two small drawbacks:

  1. The documentation strings sometimes miss highlighting, e.g. [1, -1, 2, -2,...] in pentagonals. Cross-references would also be great, e.g. pentagonals could point to nthPentagonal in its documentation.
  2. Type annotations for workers (the local bindings) only contribute noise, as their type will be inferred by its surrounding function's types.

For example

integerStream :: [Integer]
integerStream = map integerOrdering [1 .. ]
    where
    integerOrdering :: Integer -> Integer
    integerOrdering n
        | n `rem` 2 == 0 = (n `div` 2) * (-1)
        | otherwise = (n `div` 2) + 1

doesn't need the second type annotation:

integerStream :: [Integer]
integerStream = map integerOrdering [1 .. ]
    where
    integerOrdering n
        | n `rem` 2 == 0 = (n `div` 2) * (-1)
        | otherwise = (n `div` 2) + 1

Convey ideas in code as direct as possible

Above, we use n `rem` 2 == 0 to check whether a number is even. However, there is already a function for that: even. It immediately tells us the purpose of the expression, so let's use that:

integerStream :: [Integer]
integerStream = map integerOrdering [1 .. ]
    where
    integerOrdering n
        | even n    = (n `div` 2) * (-1)
        | otherwise = (n `div` 2) + 1

Use quotRem if you need both the result of rem and quot

integerStream is a special case, though: as we need both the reminder as well as div's result, we can use divMod or quotRem, e.g.

integerStream :: [Integer]
integerStream = map integerOrdering [1 .. ]
    where
    integerOrdering n
        | r         = -q
        | otherwise = q + 1
       where
        (q, r) = n `quotRem` 2

Use simpler code where applicable

We stay at integerStream. As the documentation tells us, we want to have a bijection from the sequence of natural numbers to a sequence of all integers.

While the canonical mapping is indeed

$$ f(n) = \begin{cases} \frac{n-1}{2}+1& \text{if } n \text{ is odd}\\ -\frac{n}{2}& \text{otherwise} \end{cases} $$ we don't need to use that definition in our code. Instead, we can use

$$ n_1,-n_1,n_2,-n_2,\ldots. $$

integerStream :: [Integer]
integerStream = go 1
    where
      go n = n : -n : go (n + 1)

Or, if you don't want to write it explicitly

integerStream :: [Integer]
integerStream = concatMap mirror [1..]
    where
      mirror n = [n, -n]

Both variants have the charm that no division is necessary in the computation of your list.

Use cycle for repeating lists

While the methods above arguably break down to personal preference, additiveStream can benefit from cycle:

additiveStream :: [Integer]
additiveStream = cycle [1, 1, -1, -1]

Generalize functions where applicable

delta can be written for any type that is an instance of Num an Eq, so lets generalize:

delta :: (Eq n, Num n) => n -> n -> n
delta n i
    | n == i    = n
    | otherwise = 0
\$\endgroup\$
  • \$\begingroup\$ I still need a section on memoization but I don't have any time at the moment. \$\endgroup\$ – Zeta Mar 17 at 8:10
  • \$\begingroup\$ It's all good. I'm looking into how memoization is typically done in Haskell and can probably implement it as an exercise. :) \$\endgroup\$ – Dair Mar 17 at 20:44
  • \$\begingroup\$ @Dair This Q&A on SO provides a great introduction IMHO. \$\endgroup\$ – Zeta Mar 17 at 20:56
-1
\$\begingroup\$

I tried writing divisorSum in terms of ZipList, but it kept shrinking until that wasn't needed anymore. Which is half the point of such rewrites!

divisorSum :: Integer -> Integer
divisorSum n
  | n <= 0 = 0
  | otherwise = sum $ takeWhile (/= 0) $ zipWith (*) additiveStream $
      map (\x -> divisorSum (n - x) + if x == n then 1 else 0) pentagonals

The call tree of with what arguments divisorSum calls itself is going to overlap with itself. In such situations, you can trade off space for time by keeping around a data structure that remembers the result for each possible argument after it's been calculated once. The memoize library captures this pattern:

divisorSum :: Integer -> Integer
divisorSum = memoFix $ \recurse n -> if n <= 0 then 0 else
  sum $ takeWhile (/= 0) $ zipWith (*) (cycle [1, 1, -1, -1]) $
    map (\x -> recurse (n - x) + if x == n then 1 else 0) pentagonals
\$\endgroup\$
  • 1
    \$\begingroup\$ it's nigh-impossible to understand this code without expending a significant amount of mental resources. As such this refactoring is not an improvement IMO, but a step back. There may be a point regarding performance, but clarity is the deciding factor here. The compiler can do the inlining for us... \$\endgroup\$ – Vogel612 Mar 17 at 15:52
  • \$\begingroup\$ The inlining allowed fusing the zipWiths. I think that's an improvement. Do the additional names aid your understanding? They are mere arcane symbols to me. If you find it easier to parse short definitions, simply read the code up to one $ at a time, and pretend for the time being that the remainder is an argument - that's why it's structured that way. \$\endgroup\$ – Gurkenglas Mar 17 at 18:37

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.