pidigits.c

/* The Computer Language Benchmarks Game
 * http://benchmarksgame.alioth.debian.org/
 *
 * Contributed by Mr Ledrug
*/

#include <stdio.h>
#include <stdlib.h>
#include <gmp.h>

mpz_t tmp1, tmp2, acc, den, num;
typedef unsigned int ui;

ui extract_digit(ui nth) {
   // joggling between tmp1 and tmp2, so GMP won't have to use temp buffers
   mpz_mul_ui(tmp1, num, nth);
   mpz_add(tmp2, tmp1, acc);
   mpz_tdiv_q(tmp1, tmp2, den);
   return mpz_get_ui(tmp1);
}

void eliminate_digit(ui d) {
   mpz_submul_ui(acc, den, d);
   mpz_mul_ui(acc, acc, 10);
   mpz_mul_ui(num, num, 10);
}

void next_term(ui k) {
   ui k2 = k * 2U + 1U;
   mpz_addmul_ui(acc, num, 2U);
   mpz_mul_ui(acc, acc, k2);
   mpz_mul_ui(den, den, k2);
   mpz_mul_ui(num, num, k);
}

int main(int argc, char **argv) {
   ui d, k, i;
   int n = atoi(argv[1]);

   mpz_init(tmp1);
   mpz_init(tmp2);

   mpz_init_set_ui(acc, 0);
   mpz_init_set_ui(den, 1);
   mpz_init_set_ui(num, 1);

   for (i = k = 0; i < n;) {
      next_term(++k);
      if (mpz_cmp(num, acc) > 0)
         continue;

      d = extract_digit(3);
      if (d != extract_digit(4))
         continue;

      putchar('0' + d);
      if (++i % 10 == 0)
         printf("\t:%u\n", i);
      eliminate_digit(d);
   }


   return 0;
}

pidigits.hs

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE BangPatterns #-}

-- | A copy of the C version of Pidigits from the Computer Language
-- Benchmarks Game.
--
-- http://benchmarksgame.alioth.debian.org/u64q/program.php?test=pidigits&lang=gcc&id=1

module Main where

import           Control.Monad.Fix
import           System.Environment
import           Text.Printf

data S = S
    { acc :: !Integer
    , den :: !Integer
    , num :: !Integer
    }

extract_digit :: Num b => S -> Word -> b
extract_digit S{..} (nth :: Word) =
    fromIntegral (div (num * fromIntegral nth + acc) den)

eliminate_digit :: S -> Word -> S
eliminate_digit s@S{..} (d :: Word) =
    s
    { acc = (acc - den * fromIntegral d) * 10
    , num = num * 10
    }

next_term :: S -> Word -> S
next_term S{..} (k :: Word) =
    S
    { acc = (acc + num * 2) * fromIntegral k2
    , num = num * fromIntegral k
    , den = den * fromIntegral k2
    }
  where
    k2 :: Word
    k2 = k * 2 + 1

main :: IO ()
main = do
    argv <- getArgs
    let n = read (head argv) :: Word
    fix
        (\loop !i !k !s ->
              if i < n
                  then let k' = k + 1
                           s' = next_term s k'
                       in if num s' > acc s'
                              then loop i k' s'
                              else let d = extract_digit s' 3
                                   in if d /= extract_digit s' 4
                                          then loop i k' s'
                                          else do
                                              printf "%d" d
                                              let i' = i + 1
                                              if mod i' 10 == 0
                                                  then printf "\t:%u\n" i'
                                                  else return ()
                                              let s'' = eliminate_digit s' d
                                              loop i' k' s''
                  else return ())
        0
        0
        S
        { num = 1
        , den = 1
        , acc = 0
        }