A Dozen Lines Of Code

January 24, 2012

Long-time readers of this blog will not be surprised that I based my program on prime numbers, because I think they’re really cool. I wrote three basic functions related to prime numbers. The first function uses the sieve of Eratosthenes to make a list of prime numbers less than n:

; primes n -- list of primes not greater than n in ascending order
(define (primes n) ; assumes n is an integer greater than one
  (let* ((len (quotient (- n 1) 2)) (bits (make-vector len #t)))
    (let loop ((i 0) (p 3) (ps (list 2))) ; sieve of eratosthenes
      (cond ((< n (* p p))
              (do ((i i (+ i 1)) (p p (+ p 2))
                   (ps ps (if (vector-ref bits i) (cons p ps) ps)))
                  ((= i len) (reverse ps))))
            ((vector-ref bits i)
                (do ((j (+ (* 2 i i) (* 6 i) 3) (+ j p)))
                    ((<= len j) (loop (+ i 1) (+ p 2) (cons p ps)))
                (vector-set! bits j #f)))
            (else (loop (+ i 1) (+ p 2) ps))))))

The second function uses the Miller-Rabin algorithm to determine if a number is probably prime; it uses the first 25 primes as witnesses in a strong-pseudoprime test. The first line abuses the concept of a line, but otherwise the function is properly written:

; prime? n -- #f if provably composite, else #t if probably prime
(define prime? (let ((ps (primes 100))) (lambda (n) ; integer n
  (define (spsp? n a) ; #f if n is provably composite, else #t
    (do ((d (- n 1) (/ d 2)) (s 0 (+ s 1)))
        ((odd? d)
          (if (= (expm a d n) 1) #t
            (do ((r 0 (+ r 1)))
                ((or (= (expm a (* d (expt 2 r)) n) (- n 1)) (= r s))
                  (< r s)))))))
  (if (member n ps) #t
    (do ((ps ps (cdr ps)))
        ((or (null? ps) (not (spsp? n (car ps)))) (null? ps)))))))

The third function uses Pollard’s rho algorithm to find the factors of an integer; it takes any integer, including negative numbers, which may be stretching the mathematical definition of factoring, but such factorizations are occasionally useful. Notice that there is no limit, so the function will continue to work until it completes the requested factorization, which will be a while in the case where the factors are large. This was the hardest function to contort into twelve lines, and required several rewrites as well as several instances of abuse of the concept of a line:

; factors n -- list of prime factors of n in ascending order
(define (factors n) ; assumes n is an integer, may be negative
  (if (<= -1 n 1) (list n) (if (< n 0) (cons -1 (factors (- n)))
    (let fact ((n n) (c 1) (fs (list))) ; pollard rho method
      (define (f x) (modulo (+ (* x x) c) n))
      (if (even? n) (fact (/ n 2) c (cons 2 fs)) (if (= n 1) fs
        (if (prime? n) (sort < (cons n fs))
          (let loop ((t 2) (h 2) (d 1))
            (if (= d 1) (let ((t (f t)) (h (f (f h))))
                          (loop t h (gcd (- t h) n)))
              (if (= d n) (fact n (+ c 1) fs)
                (if (prime? d) (fact (/ n d) (+ c 1) (cons d fs))
                  (fact n (+ c 1) fs))))))))))))

Those aren’t the best functions of their kind, but they’re not bad, either, suitable for a modest library on the subject; taken together, they will solve all the prime-number problems at Project Euler.

We used expm from the Standard Prelude. You can run the program at http://programmingpraxis.codepad.org/soelfszm.

About these ads

Pages: 1 2

16 Responses to “A Dozen Lines Of Code”

  1. David said

    In ruby, less than a dozen lines you can write a program to display the frequency all the words in a file (“word” defined loosely here as C/C++ style identifier, except it also accepts leading digits as “words” so it should do a reasonable job for text (i.e. not programming language) documents)

    wcount = Hash.new 0
    
    $stdin.each do |line|
        line.scan /[a-zA-Z0-9_]+/ do |word|
            wcount[word.downcase] += 1
        end
    end
    
    wcount.sort.each do |w,c|
        printf "%-15s %d\n", w, c
    end
    

    Analyzing itself:

    PS C:\Users\dave\Documents\dev\cs453> cat wf.rb | ruby wf.rb
    0               1
    1               1
    15s             1
    9_              1
    a               1
    c               2
    d               1
    do              3
    downcase        1
    each            2
    end             3
    hash            1
    line            2
    n               1
    new             1
    printf          1
    scan            1
    sort            1
    stdin           1
    w               2
    wcount          3
    word            2
    z0              1
    za              1
    
  2. Ben Simon said

    Here’s my solution:

    ;; A simple Boss Key app. My contribution to the dozen-line program contest.
    NeedToHide = .*(Mozilla|Explorer|Chrome).*
    WantToShow = .*emacs.*
    #b::
    SetTitleMatchMode, RegEx
    WinGet, id, list, %NeedToHide%
    Loop, %id% {
    this_id := id%A_Index%
    WinHide, ahk_id %this_id%
    }
    WinActivate, %WantToShow%
    Return,

    And some explanation behind it: http://benjisimon.blogspot.com/2012/01/my-dozen-lines-of-code.html

  3. [...] today’s Programming Praxis exercise, our goal is to make any program we want, as long as it’s cool [...]

  4. My Haskell program, which is an 11-line implementation of Conway’s Game of Life (see http://bonsaicode.wordpress.com/2012/01/24/programming-praxis-a-dozen-lines-of-code/ for a version with comments):

    import qualified Data.List.Key as K
    import qualified Data.Map as M
    
    rule (cy,cx) m = elem ns $ if alive (cy,cx) then [2,3] else [3] where
        ns = sum [1 | y <- [-1..1], x <- [-1..1], (y,x) /= (0,0), alive (cy+y,cx+x)]
        alive (x, y) = M.lookup (x, y) m == Just 'x'
    
    step m = if null on then M.empty else M.fromList
        [((y,x),if rule (y,x) m then 'x' else '.') | y <- range fst, x <- range snd]
        where on = M.keys $ M.filter (== 'x') m
              range f = [minimum (map f on) - 1..maximum (map f on) + 1]
    
    load s = M.fromList [((y,x),c) | (y,l)<-zip [0..] $ lines s, (x,c)<-zip [0..] l]
    
    display = mapM_ (putStrLn . map snd) . ([] :) . K.group (fst . fst) . M.assocs
    
    main = mapM_ (display . snd) . takeWhile (uncurry (/=)) .
        (\l -> zip l $ tail l) . iterate step . load =<< readFile "life.txt"
    

    Note that I am not counting the import statements as lines of code.

  5. brice said
    #!/usr/bin/env python
    """
    pinc.py: an arbitraty text include filter.
    
    Pinc.py reads a source file with include directives in the following format:
    
        ...
        (> file_to_include.ext <)
        (!> file_to_execute.sh --args foo <)
        ...
    
    Included files will be included verbatim. If executing a file, the stdout will be included.
    
    If a directive is indented, as follows:
    
        ...
        normal text
            (> file_to_include.ext <)
        more normal text
        ...
    
    Then the indentation will be preserved for all included lines.
    
    Includes cannot be escaped, but any non-whitespace character before a directive will make pinc.py ignore the directive. For example:
    
        ...
        some text
             (> will_be_included.txt <)
        some more text
        this (> will_NOT_be_included.txt <)
        even more text
        ...
    
    pinc.py reads from the stdin and writes to stdout. It takes no arguments.
    
    pinc.py is one pass non-recursive. The included text is not parsed for pinc.py directive.
    
    """
    import sys, re, od.path, shlex, subprocess
    for line in sys.stdin:
      match_exe = re.match(r'(\s*)\(!>(.*)<\)\s*', line)
      match_inc = re.match(r'(\s*)\(>(.*)<\)\s*', line)
      if match_exe:
        space, args = match_exe.groups()
        sys.stdout.writelines(map(lambda x: space+x+"\n", subprocess.check_output(shlex.split(args)).split("\n")))
      elif match_inc:
        space, inc = match_inc.groups()
        sys.stdout.writelines(map(lambda x: space+x, open(inc.strip())))
      else:
        sys.stdout.write(line)
    
  6. brice said

    For the above, substitute od.path for os.path.

    To use pinc.py as a quine, try: [tt]echo “(> pinc.py >)” | python pinc.py[/tt]

  7. phillip said

    def add(x,y): #assumes both numbers are postive.
    while y > 0:
    x,y = x^y, (x&y)<0:
    if y&1 == 1:
    total = add(total,x)
    x = x<>1
    return x
    {/sourcecode]

  8. phillip said

    hmm the source code optino didnt work very well. heres the pastebin option
    code

  9. Gambiteer said

    This computes a Brent-Salamin approximation to pi with k digits base b.
    Edited from the Gambit examples.

    > (pi-brent-salamin 10 100)
    31415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170374

    (define (pi-brent-salamin b k) ; k is number of digits
      (define q quotient) (define is integer-sqrt)
      (define b^k (expt b k)) (define (f.* x y) (q (* x y) b^k))
      (define (f.square x) (f.* x x)) (define (f./ x y) (q (* x b^k) y))
      (define (f.sqrt x) (is (* x b^k))) (define (n->f x) (round (* x b^k)))
      (let ((one (n->f 1)))
        (let loop ((a one) (b (f.sqrt (q one 2))) (t (q one 4)) (x 1))
          (if (= a b) (q (* a a) t)
              (let ((new-a (q (+ a b) 2)))
                (loop new-a (is (* a b))
                      (- t (* x (f.square (- new-a a)))) (* 2 x)))))))
    
  10. sunwukong said

    I’ve modified one of my old snippets… (see my website for the original)

    /circle { 0 360 arc fill } def
    /disc { 0 0 0 setrgbcolor x y r circle
              0 0 setrgbcolor x 3 sub y 3 add r circle } def
    5000 { /x rand 595 mod def
           /y rand 842 mod def
           /r rand 40 mod 10 add def
           rand 128 mod 100 add 256 div disc } repeat
    /line 842 18 sub def /file (discs.ps) (r) file def
    /Courier-Bold findfont 16 scalefont setfont 1 1 1 setrgbcolor
    /buffer 80 string def { file buffer readline
        { 4 line moveto show /line line 30 sub def }
        { exit } ifelse } loop
    

    Okay, I admit that the lines are a bit overfull… but the result quite worths it,
    see an image here.

  11. A python program that generates high frequencies can be used as a dog whistle and also to annoy your friends.

    from winsound import *;import random
    while True:Beep(random.randint(300,1000),random.randint(500,1000))

  12. ardnew said

    Perl iterative permutation algorithm (Fischer-Krause) to permute the characters of a string.

    11 lines (although slightly abused with the 1-line while loops), max width of 67 characters:

    sub permute($$) {
      @{$_[0]} = sort { $a cmp $b } @{$_[0]};  
      while (print "@{$_[0]}\n") {        
        my ($k, $j) = ($_[1] - 1, $_[1] - 1);    
        --$k while ((${$_[0]}[$k - 1] cmp ${$_[0]}[$k]) >= 0);  
        last if $k < 1; 
        --$j while ((${$_[0]}[$k - 1] cmp ${$_[0]}[$j]) >= 0);      
        @{$_[0]}[$j, $k - 1] = @{$_[0]}[$k - 1, $j];
        @{$_[0]}[$k .. $_[1] - 1] = reverse @{$_[0]}[$k .. $_[1] - 1];    
      }
    }
    

    Driver/demo program:

    if (scalar @ARGV) {
      my @data = split '', $ARGV[0];
      permute(\@data, scalar @data);
    }
    

    Output:

    $ perl permute.pl abc
    a b c
    a c b
    b a c
    b c a
    c a b
    c b a
    
  13. Manoj Senguttuvan said

    The ‘Divisors’ Problem (http://programmingpraxis.com/2012/02/14/divisors/) under 12 lines :P

    <? $n=$argv[1];
    for($count=0,$j=0,$i=1;$i<=$n;$i++,$j=0,$count=0)
                    while($j++<=$i) $arr[$i][$count]=$i%$j==0?$j*(++$count/$count):$arr[$i][$count];
    echo "Perfect: "; 
    for($sums=array(),$sum=0,$i=1;$i<=$n;$i++,$sum=0)
    {        foreach( $arr[$i] as $j => $val) $sum+=$val;
             echo $sum==2*$i?$i." ":"";
            $sums[$i]=$sum-$i; }
    print "\nAmicable Pairs: "; for($i=2;$i<=$n;$i++)
    {        $x=$sums[$i];
            if($x<$i && $sums[$x]==$i) echo "($i,$x) "; } ?>
    
  14. Will Ness said

    How can we not have here a linearithmic (more or less) primes generating code in 8 lines of Haskell: :)

    primes = 2 : _Y ((3:) . diff [5,7..] . unionAll . map (\p-> [p*p, p*p+2*p..]))
    _Y g = g (_Y g)  
    unionAll ((x:xs):t) = x : (joyn xs . unionAll . pairs) t  
       where   pairs (a:b:t) = joyn a b : pairs t
    ordzip a b = g a b   where { g a@(x:r) b@(y:q)   
       | x<y = (x,0):g r b | y<x = (0,y):g a q | otherwise = (x,y):g r q }  
    diff xs ys = [x | (x,y)<- ordzip xs ys, x/=0 && y==0]   
    joyn xs ys = [z | (x,y)<- ordzip xs ys, x/=0 || y/=0, let z=max x y] 
    

    Test it at http://codepad.org/Z62VCphw.

  15. Will Ness said

    Forgot to mention that the code itself is a _genuine one-liner_; all the rest are general auxiliary utilities. :)

  16. Will Ness said

    For instance, the intersection of two ordered increasing lists – a function not used in `primes` – is

    meet xs ys = [x | (x,y)<- ordzip xs ys, x/=0 && y/=0] 
    

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Follow

Get every new post delivered to your Inbox.

Join 629 other followers

%d bloggers like this: