Paste: pidigits benchmark - initial attempt

Author: elasticdog
Mode: factor
Date: Thu, 23 Apr 2009 05:11:37
Plain Text | 
USING: arrays formatting fry generalizations grouping io kernel locals math
    math.functions math.matrices math.parser math.primes.factors math.vectors
    prettyprint sequences sequences.deep sets ;
IN: benchmark.pidigits

: extract ( z x -- n )
    1 2array '[ _ v* sum ] map first2 /i ;

: next ( z -- n )
    3 extract ;

: safe? ( z n -- ? )
    [ 4 extract ] dip = ;

: >matrix ( q s r t -- z )
    4array 2 group ;

: produce ( z n -- z' )
    [ 10 ] dip -10 * 0 1 >matrix swap m. ;

: gen-x ( x -- matrix )
    dup 2 * 1 + [ 2 * 0 ] keep >matrix ;

: consume ( z k -- z' )
    gen-x m. ;

! version without printing in required format
: digits ( k z n -- )
    dup 0 > [
        over next pick over safe? [
            dup number>string write
            swap [ produce ] dip 1 - digits
        ] [
            drop [ [ 1 + ] keep ] [ swap consume ] [ ] tri* digits
        ] if
    ] [ 3drop nl ] if ;

! version without printing in required format, using locals
:: ldigits ( k z n -- )
    n 0 > [
        z next :> y
        z y safe? [
            y number>string write
            k z y produce n 1 - ldigits
        ] [
            k 1 + z k consume n ldigits
        ] if
    ] when ;

: (padded-total) ( col row -- n str str )
    [ + "" swap ]
    [ drop [ "%" "s\t:%d\n" 10 ] dip ]
    2bi - number>string glue ;

: padded-total ( col row -- )
    (padded-total) '[ _ printf ] call( n str -- ) ;

! version that prints in required format, using locals
:: fdigits ( k z n row col -- )
    n 0 > [
        z next :> y
        z y safe? [
            col 10 = [
                row 10 + y "\t:%d\n%d" printf
                k z y produce n 1 - row 10 + 1 fdigits
            ] [
                y number>string write
                k z y produce n 1 - row col 1 + fdigits
            ] if
        ] [
            k 1 + z k consume n row col fdigits
        ] if
    ] [ col row padded-total ] if ;

: pi-digits ( n -- )
    ! [ 1 { { 1 0 } { 0 1 } } ] dip digits ;
    ! [ 1 { { 1 0 } { 0 1 } } ] dip ldigits ;
    [ 1 { { 1 0 } { 0 1 } } ] dip 0 0 fdigits ;

Annotation: cleaned up, though no optimizations

Author: elasticdog
Mode: factor
Date: Fri, 24 Apr 2009 05:55:31
Plain Text | 
! Copyright (c) 2009 Aaron Schaefer. All rights reserved.
! The contents of this file are licensed under the Simplified BSD License
! A copy of the license is available at http://factorcode.org/license.txt
USING: arrays formatting fry grouping io kernel locals math math.functions
    math.matrices math.parser math.primes.factors math.vectors prettyprint
    sequences sequences.deep sets ;
IN: benchmark.pidigits

: extract ( z x -- n )
    1 2array '[ _ v* sum ] map first2 /i ;

: next ( z -- n )
    3 extract ;

: safe? ( z n -- ? )
    [ 4 extract ] dip = ;

: >matrix ( q s r t -- z )
    4array 2 group ;

: produce ( z n -- z' )
    [ 10 ] dip -10 * 0 1 >matrix swap m. ;

: gen-x ( x -- matrix )
    dup 2 * 1 + [ 2 * 0 ] keep >matrix ;

: consume ( z k -- z' )
    gen-x m. ;

:: (padded-total) ( row col -- str n format )
    "" row col + "%" "s\t:%d\n"
    10 col - number>string glue ;

: padded-total ( col row -- )
    (padded-total) '[ _ printf ] call( str n -- ) ;

:: digits ( k z n row col -- )
    n 0 > [
        z next :> y
        z y safe? [
            col 10 = [
                row 10 + y "\t:%d\n%d" printf
                k z y produce n 1 - row 10 + 1 digits
            ] [
                y number>string write
                k z y produce n 1 - row col 1 + digits
            ] if
        ] [
            k 1 + z k consume n row col digits
        ] if
    ] [ row col padded-total ] if ;

: pi-digits ( n -- )
    [ 1 { { 1 0 } { 0 1 } } ] dip 0 0 digits ;

: pidigits-main ( -- )
    10000 pi-digits ;

MAIN: pidigits-main

New Annotation

Summary:
Author:
Mode:
Body: