Re: Pfannkuch revisited

From	"WJ" <w_a_x_man@yahoo.com>
Newsgroups	comp.lang.forth
Subject	Re: Pfannkuch revisited
Date	2013-07-08 00:55 +0000
Organization	A noiseless patient Spider
Message-ID	<krd2l2$273$1@dont-email.me> (permalink)
References	<83979309918435@frunobulax.edu>

Show all headers | View raw

Marcel Hendrix wrote:

> Pfannkuch (Computer Language Shootout) was mentioned recently ... 
> 
> Back in 2006 I wasn't happy that 580 ms was the best 
> iForth could do, compared to 330 ms in 'C'.
> 
> Tonight I looked at it again. Based on Stephen Pelc's remarks I removed 
> all local variables -- that shaved off about 100 ms. Doing the I/O
> differently speeded it up another 100 ms. The Forth and C version now 
> behave nearly the same. The C version is using ints where Forth uses bytes.
> Timings are done on the same machine, I recompiled and optimized the C 
> version as good as it would go. (It is a 64bit program, but ints are 32 bits
> on Windows).
> 
> -marcel
> 
> -- -------------------------------------------
> (*
>  * LANGUAGE    : ANS Forth with extensions
>  * PROJECT     : Forth Environments
>  * DESCRIPTION : Fannkuch benchmark
>  * CATEGORY    : Benchmarks
>  * AUTHOR      : Marcel Hendrix 
>  * LAST CHANGE : June 10, 2006, Marcel Hendrix 
>  * LAST CHANGE : Wednesday, December 26, 2012, 00:12, Marcel Hendrix 
>  *)
> 
> 
> 	NEEDS -miscutil
> 
> 	REVISION -fannkuch5 "--- Fannkuch (C)        Version 5.00 ---"
> 
> 
> DOC
> (*
>  fannkuch benchmark | C gcc | fannkuch full data 
> 
>  fannkuch C gcc program
>  N  Full CPU Time s   Memory Use KB   GZip Bytes 
>  10      0.45              16,384         612 
> 
> /*
>  * The Computer Language Shootout
>  * http://shootout.alioth.debian.org/
>  * Contributed by Heiner Marxen
>  *
>  * "fannkuch"	for C gcc
>  *
>  * $Id: fannkuch-gcc.code,v 1.33 2006/02/25 16:38:58 igouy-guest Exp $
>  */
> 
> 	PROGRAM OUTPUT
> 	==============
> 	12345678910
> 	21345678910
> 	23145678910
> 	32145678910
> 	31245678910
> 	13245678910
> 	23415678910
> 	32415678910
> 	34215678910
> 	43215678910
> 	42315678910
> 	24315678910
> 	34125678910
> 	43125678910
> 	41325678910
> 	14325678910
> 	13425678910
> 	31425678910
> 	41235678910
> 	14235678910
> 	12435678910
> 	21435678910
> 	24135678910
> 	42135678910
> 	23451678910
> 	32451678910
> 	34251678910
> 	43251678910
> 	42351678910
> 	24351678910
> 	Pfannkuchen(10) = 38
> *)
> ENDDOC
> 
>  #10 =: N
> N 1- =: N1
> 
> CREATE perm   N ALLOT 
> CREATE perm1  N ALLOT
> CREATE counts N ALLOT
> 
> 0 VALUE didpr
> 0 VALUE flips
> 0 VALUE flipsMax
> 
> CREATE obuffer #4096 CHARS ALLOT
> 
> : oinit ( -- ) obuffer 0! ;
> : >out ( c-addr u -- ) obuffer CELLPLACE+ ;
> : CR>out ( -- ) $CR COUNT >out ;
> : .pan ( -- ) CR>out  N 0 DO  perm1 I + C@ 1+ (0DEC.R) >out  LOOP ;
> 
> : XCH ( ix1 ix2 -- ) 
> 	perm + SWAP perm + 
> 	DUP C@ >R  SWAP DUP C@ ( -- addr1 addr2 n2 )
> 	ROT C!  R> SWAP C! ;
> 
> -- N = 10
> 64BIT? 
>   [IF]
> : special-move ( -- )
> 	  perm1 1+   @   perm 1+   !
> 	  perm1 9 + C@   perm 9 + C! ; 
> [ELSE]
> : special-move ( -- )
> 	  perm1 1+   @   perm 1+   !
> 	  perm1 5 +  @   perm 5 +  ! 
> 	  perm1 9 + C@   perm 9 + C! ; 
> [THEN]
> 
> : fannkuch ( -- u )
> 	N 1 < IF  0 EXIT  ENDIF
> 	CLEAR didpr CLEAR flips CLEAR flipsMaX
> 	N >R
> 	perm1 N 0 DO  I SWAP C!+  LOOP	DROP \ initial (trivial) permute 
> 	BEGIN
> 		didpr #30 < IF  .pan 1 +TO didpr  ENDIF
> 
> 		counts R@ 1- + R>
> 		BEGIN  DUP 1 <>  
> 		WHILE  DUP 2 PICK C!  
> 		       1-   SWAP 1- SWAP
> 		REPEAT >R DROP
> 
> 		perm1 C@ 0=  
> 		perm1 N1 + C@ N1 = OR  0= 
> 		   IF  	0 TO flips
> 			special-move 
> 			perm1 C@ >R			\ cache perm[0] on R
> 			BEGIN				\ k1 != 0 ==> k1>0 
> 				1  R@ 1-     	( -- i1 j1 )
> 				BEGIN	2DUP <
> 				WHILE 	2DUP XCH
> 					1- SWAP 1+ SWAP
> 				REPEAT  2DROP
> 				R> DUP perm + DUP C@ >R C! ( R: -- j1 )  
> 				1 +TO flips
> 				R@ 0=
> 			UNTIL 	-R
> 			flipsMax flips < IF  flips TO flipsMax  ENDIF
> 		ENDIF
> 		BEGIN  R@ N = IF  flipsMax -R EXIT  ENDIF \ rotate down perm[0..r] by one 
> 		       perm1 C@ ( perm0)  0 
> 		       BEGIN  DUP R@ <
> 		       WHILE  1+ 
> 		              DUP perm1 +  DUP C@  SWAP 1- C!
> 		       REPEAT DROP ( perm0)  
> 		       perm1  R@ + C!
> 		       counts R@ + DUP C@ 1-  DUP ROT C!  0<=
> 		WHILE  R> 1+ >R
> 		REPEAT
> 	AGAIN ;
> 
> : main ( -- ) 
> 	oinit
> 	TIMER-RESET 
> 	 fannkuch 
> 	 CR>out S" Pfannkuchen(" >out N (0DEC.R) >out S" ) = " >out (.) >out 
> 	CR .ELAPSED 
> 	obuffer @+ TYPE ;
> 
> :ABOUT	CR ." Try: main -- Standard Shootout test (VC++ 6.0: 333 ms). Should be around 352 ms." 
> 	CR ." Using TYPE gives 450 ms."  ;
> 
> 		.ABOUT -fannkuch5 CR
> 
>                               (* End of Source *)

Here's a version in Julia.  On my old, tired, battered laptop
it runs in 0.734 seconds.

const N = 10


function reverse_some( vector, top )
  i, j = 2, top
  while i < j
    tmp = vector[ i ]
    vector[ i ] = vector[ j ]
    vector[ j ] = tmp
    j -= 1
    i += 1
  end
end


function shift_left( vector, top )
  tmp = vector[1]
  for i = 2:top
    vector[i-1] = vector[i]
  end
  vector[top] = tmp
end


function print_vector( vector )
  for i in 1:N
    print( vector[i] )
  end
  println()
end

function flipping( perm )
  flips = 0
  k = perm[1]
  while k > 1
    reverse_some( perm, k - 1 )
    flips += 1
    tmp = perm[ k ]
    perm[ k ] = k
    k = tmp
  end
  flips
end


function copy_vector( v1, v2 )
  for i in 1:N
    v2[i] = v1[i]
  end
end


function fannkuch()
  maxflips = prn_count = 0
  r = N
  permp = vec( 1:N )
  perm = copy( permp )
  counts = zeros( Int, N )

  while true
    if prn_count < 30
      prn_count += 1
      print_vector( permp )
    end
    for i = 2:r
      counts[ i ] = i
    end
    r = 1

    if (permp[1] != 1) && (permp[N] != N)
      copy_vector( permp, perm )
      flips = flipping( perm )
      maxflips = max( flips, maxflips )
    end

    while true
      if r == N
        println( "Pfannkuchen($N) = $maxflips" )
        return
      end
      shift_left( permp, r + 1 )
      counts[ r + 1 ] -= 1
      if counts[ r + 1] > 0
        break
      else
        r += 1
      end
    end
  end
end

t = time()
fannkuch()
println( time() - t )

Back to comp.lang.forth | Previous | Next | Find similar

Thread

Re: Pfannkuch revisited "WJ" <w_a_x_man@yahoo.com> - 2013-07-08 00:55 +0000

csiph-web