Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]


Groups > comp.lang.forth > #24314 > unrolled thread

Fortran proves Forth a stone-age toy

Started by"WJ" <w_a_x_man@yahoo.com>
First post2013-07-09 07:14 +0000
Last post2013-07-12 05:14 -0500
Articles 9 — 6 participants

Back to article view | Back to comp.lang.forth


Contents

  Fortran proves Forth a stone-age toy "WJ" <w_a_x_man@yahoo.com> - 2013-07-09 07:14 +0000
    Re: Fortran proves Forth a stone-age toy m.a.m.hendrix@tue.nl - 2013-07-09 01:03 -0700
    Re: Fortran proves Forth a stone-age toy "Ed" <invalid@invalid.com> - 2013-07-09 19:32 +1000
    Re: Fortran proves Forth a stone-age toy "WJ" <w_a_x_man@yahoo.com> - 2013-07-09 22:26 +0000
      Re: Fortran proves Forth a stone-age toy "WJ" <w_a_x_man@yahoo.com> - 2013-07-11 00:01 +0000
        Re: Fortran proves Forth a stone-age toy "WJ" <w_a_x_man@yahoo.com> - 2013-07-12 12:10 +0000
    Re: Fortran proves Forth a stone-age toy hughaguilar96@yahoo.com - 2013-07-10 11:10 -0700
      Re: Fortran proves Forth a stone-age toy "Rod Pemberton" <do_not_have@notemailnotq.cpm> - 2013-07-12 03:14 -0400
        Re: Fortran proves Forth a stone-age toy Richard Owlett <rowlett@pcnetinc.com> - 2013-07-12 05:14 -0500

#24314 — Fortran proves Forth a stone-age toy

From"WJ" <w_a_x_man@yahoo.com>
Date2013-07-09 07:14 +0000
SubjectFortran proves Forth a stone-age toy
Message-ID<krgd8b$vji$1@dont-email.me>
I threw together a Fortran version of the Fannkuch program that
runs in only 0.203 seconds on my tired, old, battered laptop.

That leaves the iForth version in the dust.

In addition, the Fortran program is immeasurably more readable
and maintainable.




! 0.203125000 seconds on Intel Core2 Duo CPU P8600 @ 2.4GHz

! GFortran (gcc version 4.8.0 20130302)
! Compile with
! gfortran -O3 -march=native fannkuch.f95

program fannkuch
  implicit none
  integer, parameter :: N = 10
  integer :: perm(N), permp(N), counts(N), tmp, i, flips
  integer :: maxflips = 0, prn_count = 0, r = N
  real :: t1, t2

  call cpu_time( t1 )

  do i = 1, N
    permp(i) = i
    counts(i) = 0
  end do

  do while (.true.)
    if (prn_count < 30) then
      prn_count = prn_count + 1
      call print_vector( permp )
    end if
    do i = 2, r
      counts(i) = i
    end do
    r = 1

    if ( permp(1) /= 1  .and.  permp(N) /= N  ) then
      perm = permp
      flips = flipping( perm )
      if (flips > maxflips) maxflips = flips
    end if

    do while (.true.)
      if (N == r) then
        print "(A:,I0,A:,I0)", "Pfannkuchen(", N, ") = ", maxflips
        call cpu_time( t2 )
        print *, t2 - t1
        stop
      end if
      i = r + 1

      ! ---  Shift left.
      tmp = permp(1)
      permp(1:i-1) = permp(2:i)
      permp(i) = tmp

      counts(i) = counts(i) - 1
      if (counts(i) > 0)  exit
      r = r + 1
    end do

  end do

  contains

  integer function flipping( perm )
    implicit none
    integer :: perm(N)
    integer :: k, tmp, flips
    flips = 0
    k = perm(1)
    do while (k > 1)
        ! --- Reverse part.
      if (k > 3) call reverse_some( perm, k - 1 )
      flips = flips + 1
      tmp = perm(k)
      perm(k) = k
      k = tmp
    end do
    flipping = flips
  end function flipping

  subroutine print_vector( v )
    implicit none
    integer :: v(N), i
    do i = 1, ubound(v,1)
      write (*, "(I0)", advance="no"), v(i)
    end do
    print *, ""
  end subroutine

  subroutine reverse_some( vector, top )
    implicit none
    integer :: vector(N), top, i, j, tmp
    i = 2
    j = top
    do while (i < j)
      tmp = vector( i )
      vector( i ) = vector( j )
      vector( j ) = tmp
      j = j - 1
      i = i + 1
    end do
  end

end program fannkuch






> From: mhx@iae.nl (Marcel Hendrix)
> Subject: Pfannkuch revisited
> Date: Wed, 26 Dec 2012 10:06:52 +0200
> Message-ID: <83979309918435@frunobulax.edu>
> Lines: 180
> 
> 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 *)
> 

[toc] | [next] | [standalone]


#24315

Fromm.a.m.hendrix@tue.nl
Date2013-07-09 01:03 -0700
Message-ID<d88fe892-c8e3-498f-9928-f922737e2fbd@googlegroups.com>
In reply to#24314
On Tuesday, July 9, 2013 9:14:25 AM UTC+2, WJ wrote:
> I threw together a Fortran version of the Fannkuch program
> that runs in only 0.203 seconds on my tired, old, battered
> laptop. That leaves the iForth version in the dust.
> In addition, the Fortran program is immeasurably more
> readable and maintainable.

You can't have it both. If you really think that iForth is
left in the dust by Fortran (i.e. that run-time speed is
all-important), and if you think that fact makes
it a stone-age toy, then all the programming languages you've
demonstrated recently are "stone-age toys" too. It seems
you are then wasting everybody's time, including your own.

The fact that you think the Fortran program is "immeasurably
more readable and maintainable" is subjective. IMO, it is
not readable.

It is certainly interesting that the Fortran program is so
fast, thank you for uncovering this surprising fact. I assume
the card punch connected to your laptop is solid-state and not
electromechanical?

Because N=10 is known to the compiler, it is certainly
possible that the result is computed at compile time.
In the context of Forth this is trivially duplicated, but it
is an interesting technical accomplishment nonetheless.

In case the result is not computed at compile-time,
I would be very interested in knowing where the Fortran speed
comes from. The compiled Fortran/Forth code looks quite
similar, however, instruction selection and code placement
apparently makes an enormous difference. I would really like
to see a detailed expert review of this phenomenon.

-marcel

[toc] | [prev] | [next] | [standalone]


#24317

From"Ed" <invalid@invalid.com>
Date2013-07-09 19:32 +1000
Message-ID<krgl8l$e1l$1@speranza.aioe.org>
In reply to#24314
WJ wrote:
> I threw together a Fortran version of the Fannkuch program that
> runs in only 0.203 seconds on my tired, old, battered laptop.
>
> That leaves the iForth version in the dust.
>
> In addition, the Fortran program is immeasurably more readable
> and maintainable.

Forth is not for everyone :)

Forth being a stone-age toy, we should have a contest for same.
I'm putting the finishing touches to my new ANS Forth for CP/M-80
and would be pleased to nominate it.

O.T.  In the course of creating the above I've come to the conclusion
RESIZE-FILE should have gone into File-Access Extension since
a) not all OS support such a function and  b) it's not essential and the
effect can be achieved in other ways.


[toc] | [prev] | [next] | [standalone]


#24333

From"WJ" <w_a_x_man@yahoo.com>
Date2013-07-09 22:26 +0000
Message-ID<kri2n3$84q$1@dont-email.me>
In reply to#24314
WJ wrote:

> 
> I threw together a Fortran version of the Fannkuch program that
> runs in only 0.203 seconds on my tired, old, battered laptop.
> 
> That leaves the iForth version in the dust.
> 
> In addition, the Fortran program is immeasurably more readable
> and maintainable.
> 
> 
> 
> 
> ! 0.203125000 seconds on Intel Core2 Duo CPU P8600 @ 2.4GHz
> 
> ! GFortran (gcc version 4.8.0 20130302)
> ! Compile with
> ! gfortran -O3 -march=native fannkuch.f95
> 
> program fannkuch
>   implicit none
>   integer, parameter :: N = 10
>   integer :: perm(N), permp(N), counts(N), tmp, i, flips
>   integer :: maxflips = 0, prn_count = 0, r = N
>   real :: t1, t2
> 
>   call cpu_time( t1 )
> 
>   do i = 1, N
>     permp(i) = i
>     counts(i) = 0
>   end do
> 
>   do while (.true.)
>     if (prn_count < 30) then
>       prn_count = prn_count + 1
>       call print_vector( permp )
>     end if
>     do i = 2, r
>       counts(i) = i
>     end do
>     r = 1
> 
>     if ( permp(1) /= 1  .and.  permp(N) /= N  ) then
>       perm = permp
>       flips = flipping( perm )
>       if (flips > maxflips) maxflips = flips
>     end if
> 
>     do while (.true.)
>       if (N == r) then
>         print "(A:,I0,A:,I0)", "Pfannkuchen(", N, ") = ", maxflips
>         call cpu_time( t2 )
>         print *, t2 - t1
>         stop
>       end if
>       i = r + 1
> 
>       ! ---  Shift left.
>       tmp = permp(1)
>       permp(1:i-1) = permp(2:i)
>       permp(i) = tmp
> 
>       counts(i) = counts(i) - 1
>       if (counts(i) > 0)  exit
>       r = r + 1
>     end do
> 
>   end do
> 
>   contains
> 
>   integer function flipping( perm )
>     implicit none
>     integer :: perm(N)
>     integer :: k, tmp, flips
>     flips = 0
>     k = perm(1)
>     do while (k > 1)
>         ! --- Reverse part.
>       if (k > 3) call reverse_some( perm, k - 1 )
>       flips = flips + 1
>       tmp = perm(k)
>       perm(k) = k
>       k = tmp
>     end do
>     flipping = flips
>   end function flipping
> 
>   subroutine print_vector( v )
>     implicit none
>     integer :: v(N), i
>     do i = 1, ubound(v,1)
>       write (*, "(I0)", advance="no"), v(i)
>     end do
>     print *, ""
>   end subroutine
> 
>   subroutine reverse_some( vector, top )
>     implicit none
>     integer :: vector(N), top, i, j, tmp
>     i = 2
>     j = top
>     do while (i < j)
>       tmp = vector( i )
>       vector( i ) = vector( j )
>       vector( j ) = tmp
>       j = j - 1
>       i = i + 1
>     end do
>   end
> 
> end program fannkuch
> 
> 
> 
> 
> 
> 
> > From: mhx@iae.nl (Marcel Hendrix)
> > Subject: Pfannkuch revisited
> > Date: Wed, 26 Dec 2012 10:06:52 +0200
> > Message-ID: <83979309918435@frunobulax.edu>
> > Lines: 180
> > 
> > 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 *)
> > 


Shorter, but no faster:

! 0.203125000 seconds on Intel Core2 Duo CPU P8600 @ 2.4GHz

! GFortran (gcc version 4.8.0 20130302)
! Compile with
! gfortran -O3 -march=native fannkuch.f95

program fannkuch
  implicit none
  integer, parameter :: N = 10
  integer :: perm(N), permp(N), counts(N), tmp, i
  integer :: maxflips = 0, prn_count = 0, r = N
  real :: t1, t2

  call cpu_time( t1 )

  ! --- Initialize 2 vectors.
  counts = 0
  permp = (/  (i, i=1,N)  /)

  do
    if (prn_count < 30) then
      prn_count = prn_count + 1
      call print_vector( permp )
    end if
    do i = 2, r
      counts(i) = i
    end do
    r = 1
    if ( permp(1) /= 1  .and.  permp(N) /= N  ) then
      perm = permp
      maxflips = max( maxflips, flipping( perm ) )
    end if
    do
      if (N == r) then
        print "('Pfannkuchen(', I0, ') = ', I0)", N, maxflips
        call cpu_time( t2 )
        print *, t2 - t1
        stop
      end if
      i = r + 1

      ! ---  Shift left.
      tmp = permp(1)
      permp(1:i-1) = permp(2:i)
      permp(i) = tmp

      counts(i) = counts(i) - 1
      if (counts(i) > 0)  exit
      r = r + 1
    end do
  end do

  contains

  integer function flipping( perm )
    implicit none
    integer :: perm(N)
    integer :: k, tmp, flips
    flips = 0
    k = perm(1)
    do while (k > 1)
      ! --- Reverse part.
      if (k > 3) call reverse_some( perm, k - 1 )
      flips = flips + 1
      tmp = perm(k)
      perm(k) = k
      k = tmp
    end do
    flipping = flips
  end function

  subroutine print_vector( v )
    integer :: v(N)
    write (*, "(99I0)"), v
  end subroutine

  subroutine reverse_some( vector, top )
    implicit none
    integer :: vector(N), top, i, j, tmp
    i = 2
    j = top
    do while (i < j)
      tmp = vector( i )
      vector( i ) = vector( j )
      vector( j ) = tmp
      j = j - 1
      i = i + 1
    end do
  end subroutine

end program

[toc] | [prev] | [next] | [standalone]


#24383

From"WJ" <w_a_x_man@yahoo.com>
Date2013-07-11 00:01 +0000
Message-ID<krkskj$135$1@dont-email.me>
In reply to#24333
WJ wrote:

> WJ wrote:
> 
> > 
> > I threw together a Fortran version of the Fannkuch program that
> > runs in only 0.203 seconds on my tired, old, battered laptop.
> > 
> > That leaves the iForth version in the dust.
> > 
> > In addition, the Fortran program is immeasurably more readable
> > and maintainable.
> > 
> > 
> > 
> > 
> > ! 0.203125000 seconds on Intel Core2 Duo CPU P8600 @ 2.4GHz
> > 
> > ! GFortran (gcc version 4.8.0 20130302)
> > ! Compile with
> > ! gfortran -O3 -march=native fannkuch.f95
> > 
> > program fannkuch
> >   implicit none
> >   integer, parameter :: N = 10
> >   integer :: perm(N), permp(N), counts(N), tmp, i, flips
> >   integer :: maxflips = 0, prn_count = 0, r = N
> >   real :: t1, t2
> > 
> >   call cpu_time( t1 )
> > 
> >   do i = 1, N
> >     permp(i) = i
> >     counts(i) = 0
> >   end do
> > 
> >   do while (.true.)
> >     if (prn_count < 30) then
> >       prn_count = prn_count + 1
> >       call print_vector( permp )
> >     end if
> >     do i = 2, r
> >       counts(i) = i
> >     end do
> >     r = 1
> > 
> >     if ( permp(1) /= 1  .and.  permp(N) /= N  ) then
> >       perm = permp
> >       flips = flipping( perm )
> >       if (flips > maxflips) maxflips = flips
> >     end if
> > 
> >     do while (.true.)
> >       if (N == r) then
> >         print "(A:,I0,A:,I0)", "Pfannkuchen(", N, ") = ", maxflips
> >         call cpu_time( t2 )
> >         print *, t2 - t1
> >         stop
> >       end if
> >       i = r + 1
> > 
> >       ! ---  Shift left.
> >       tmp = permp(1)
> >       permp(1:i-1) = permp(2:i)
> >       permp(i) = tmp
> > 
> >       counts(i) = counts(i) - 1
> >       if (counts(i) > 0)  exit
> >       r = r + 1
> >     end do
> > 
> >   end do
> > 
> >   contains
> > 
> >   integer function flipping( perm )
> >     implicit none
> >     integer :: perm(N)
> >     integer :: k, tmp, flips
> >     flips = 0
> >     k = perm(1)
> >     do while (k > 1)
> >         ! --- Reverse part.
> >       if (k > 3) call reverse_some( perm, k - 1 )
> >       flips = flips + 1
> >       tmp = perm(k)
> >       perm(k) = k
> >       k = tmp
> >     end do
> >     flipping = flips
> >   end function flipping
> > 
> >   subroutine print_vector( v )
> >     implicit none
> >     integer :: v(N), i
> >     do i = 1, ubound(v,1)
> >       write (*, "(I0)", advance="no"), v(i)
> >     end do
> >     print *, ""
> >   end subroutine
> > 
> >   subroutine reverse_some( vector, top )
> >     implicit none
> >     integer :: vector(N), top, i, j, tmp
> >     i = 2
> >     j = top
> >     do while (i < j)
> >       tmp = vector( i )
> >       vector( i ) = vector( j )
> >       vector( j ) = tmp
> >       j = j - 1
> >       i = i + 1
> >     end do
> >   end
> > 
> > end program fannkuch
> > 
> > 
> > 
> > 
> > 
> > 
> > > From: mhx@iae.nl (Marcel Hendrix)
> > > Subject: Pfannkuch revisited
> > > Date: Wed, 26 Dec 2012 10:06:52 +0200
> > > Message-ID: <83979309918435@frunobulax.edu>
> > > Lines: 180
> > > 
> > > 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 *)
> > > 
> 
> 
> Shorter, but no faster:
> 
> ! 0.203125000 seconds on Intel Core2 Duo CPU P8600 @ 2.4GHz
> 
> ! GFortran (gcc version 4.8.0 20130302)
> ! Compile with
> ! gfortran -O3 -march=native fannkuch.f95
> 
> program fannkuch
>   implicit none
>   integer, parameter :: N = 10
>   integer :: perm(N), permp(N), counts(N), tmp, i
>   integer :: maxflips = 0, prn_count = 0, r = N
>   real :: t1, t2
> 
>   call cpu_time( t1 )
> 
>   ! --- Initialize 2 vectors.
>   counts = 0
>   permp = (/  (i, i=1,N)  /)
> 
>   do
>     if (prn_count < 30) then
>       prn_count = prn_count + 1
>       call print_vector( permp )
>     end if
>     do i = 2, r
>       counts(i) = i
>     end do
>     r = 1
>     if ( permp(1) /= 1  .and.  permp(N) /= N  ) then
>       perm = permp
>       maxflips = max( maxflips, flipping( perm ) )
>     end if
>     do
>       if (N == r) then
>         print "('Pfannkuchen(', I0, ') = ', I0)", N, maxflips
>         call cpu_time( t2 )
>         print *, t2 - t1
>         stop
>       end if
>       i = r + 1
> 
>       ! ---  Shift left.
>       tmp = permp(1)
>       permp(1:i-1) = permp(2:i)
>       permp(i) = tmp
> 
>       counts(i) = counts(i) - 1
>       if (counts(i) > 0)  exit
>       r = r + 1
>     end do
>   end do
> 
>   contains
> 
>   integer function flipping( perm )
>     implicit none
>     integer :: perm(N)
>     integer :: k, tmp, flips
>     flips = 0
>     k = perm(1)
>     do while (k > 1)
>       ! --- Reverse part.
>       if (k > 3) call reverse_some( perm, k - 1 )
>       flips = flips + 1
>       tmp = perm(k)
>       perm(k) = k
>       k = tmp
>     end do
>     flipping = flips
>   end function
> 
>   subroutine print_vector( v )
>     integer :: v(N)
>     write (*, "(99I0)"), v
>   end subroutine
> 
>   subroutine reverse_some( vector, top )
>     implicit none
>     integer :: vector(N), top, i, j, tmp
>     i = 2
>     j = top
>     do while (i < j)
>       tmp = vector( i )
>       vector( i ) = vector( j )
>       vector( j ) = tmp
>       j = j - 1
>       i = i + 1
>     end do
>   end subroutine
> 
> end program

This version sometimes runs in 0.187500000 seconds.

! GFortran (gcc version 4.8.0 20130302)
! Compile with
! gfortran -O3 -march=native fannkuch.f95

program fannkuch
  implicit none
  integer, parameter :: N = 10
  integer :: perm(N), permp(N), counts(N), tmp, i
  integer :: maxflips = 0, prn_count = 0, r = N
  real :: t1, t2

  call cpu_time( t1 )

  ! --- Initialize 2 vectors.
  counts = 0
  permp = (/  (i, i=1,N)  /)

  do
    if (prn_count < 30) then
      prn_count = prn_count + 1
      call print_vector( permp )
    end if
    do i = 2, r
      counts(i) = i
    end do
    r = 1
    if ( permp(1) /= 1  .and.  permp(N) /= N  ) then
      perm = permp
      maxflips = max( maxflips, flipping( perm ) )
    end if
    do
      if (N == r) then
        print "('Pfannkuchen(', I0, ') = ', I0)", N, maxflips
        call cpu_time( t2 )
        print *, t2 - t1
        stop
      end if
      i = r + 1

      ! ---  Shift left.
      tmp = permp(1)
      permp(1:i-1) = permp(2:i)
      permp(i) = tmp

      counts(i) = counts(i) - 1
      if (counts(i) > 0)  exit
      call inc(r, 1)
    end do
  end do

  contains

  integer function flipping( perm )
    implicit none
    integer, intent(inout) :: perm(N)
    integer :: k, tmp, flips
    flips = 0
    k = perm(1)
    do while (k > 1)
      ! --- Reverse part.
      if (k > 3) call reverse_some( perm, k - 1 )
      call inc(flips, 1)
      tmp = perm(k)
      perm(k) = k
      k = tmp
    end do
    flipping = flips
  end function

  subroutine print_vector( v )
    integer :: v(N)
    write (*, "(99I0)"), v
  end subroutine

  subroutine reverse_some( vector, top )
    implicit none
    integer, intent(inout) :: vector(N)
    integer, intent(in) :: top
    integer :: i, j, tmp
    i = 2
    j = top
    do while (i < j)
      tmp = vector( i )
      vector( i ) = vector( j )
      vector( j ) = tmp
      call inc(j, -1)
      call inc(i, 1)
    end do
  end subroutine

  subroutine inc( n, i )
    integer, intent(inout) :: n
    integer, intent(in) :: i
    n = n + i
  end subroutine


end program
 

[toc] | [prev] | [next] | [standalone]


#24432

From"WJ" <w_a_x_man@yahoo.com>
Date2013-07-12 12:10 +0000
Message-ID<kroro8$o7g$1@dont-email.me>
In reply to#24383
WJ wrote:

> 
> This version sometimes runs in 0.187500000 seconds.
> 

Final version.


! GFortran (gcc version 4.8.0 20130302)
! Compile with
! gfortran -O3 -march=native fannkuch.f95

program fannkuch
  implicit none
  integer, parameter :: N = 10
  integer :: perm(N), permp(N), counts(N), tmp, i
  integer :: maxflips = 0, prn_count = 0, r = N
  real :: t1, t2

  call cpu_time( t1 )

  ! --- Initialize 2 vectors.
  counts = 0
  permp = (/  (i, i=1,N)  /)

  do
    if (prn_count < 30) then
      call inc( prn_count, 1 )
      call print_vector( permp )
    end if
    do i = 2, r
      counts(i) = i
    end do
    r = 1
    if ( permp(1) /= 1  .and.  permp(N) /= N  ) then
      perm = permp
      maxflips = max( maxflips, flipping( perm ) )
    end if
    do
      if (N == r) then
        print "('Pfannkuchen(', I0, ') = ', I0)", N, maxflips
        call cpu_time( t2 )
        print *, t2 - t1
        stop
      end if
      i = r + 1

      ! ---  Shift left.
      tmp = permp(1)
      permp(1:i-1) = permp(2:i)
      permp(i) = tmp

      call inc( counts(i), -1 )
      if (counts(i) > 0)  exit
      call inc(r, 1)
    end do
  end do

  contains

  integer function flipping( perm )
    implicit none
    integer, intent(inout) :: perm(N)
    integer :: k, tmp, flips
    flips = 0
    k = perm(1)
    do while (k > 1)
      ! --- Reverse part.
      if (k > 3) call reverse_some( perm, k - 1 )
      call inc(flips, 1)
      tmp = perm(k)
      perm(k) = k
      k = tmp
    end do
    flipping = flips
  end function

  subroutine print_vector( v )
    integer :: v(N)
    write (*, "(99I0)"), v
  end subroutine

  subroutine reverse_some( vector, top )
    implicit none
    integer, intent(inout) :: vector(N)
    integer, intent(in) :: top
    integer :: i, j, tmp
    i = 2
    j = top
    do while (i < j)
      tmp = vector( i )
      vector( i ) = vector( j )
      vector( j ) = tmp
      call inc(j, -1)
      call inc(i, 1)
    end do
  end subroutine

  subroutine inc( n, i )
    integer, intent(inout) :: n
    integer, intent(in) :: i
    n = n + i
  end subroutine


end program

[toc] | [prev] | [next] | [standalone]


#24371

Fromhughaguilar96@yahoo.com
Date2013-07-10 11:10 -0700
Message-ID<da311a5c-8839-4dc7-808f-323c6d2a619c@googlegroups.com>
In reply to#24314
I told you previously that the hallmark of the ignormami is the use of the word "prove" to mean "provides supporting evidence for."

Not very quick on the uptake, are you?

I suppose that next you'll say that this post proves that I'm an idiot. lol

[toc] | [prev] | [next] | [standalone]


#24421

From"Rod Pemberton" <do_not_have@notemailnotq.cpm>
Date2013-07-12 03:14 -0400
Message-ID<kroa4r$1f7$1@speranza.aioe.org>
In reply to#24371
<hughaguilar96@yahoo.com> wrote in message
news:da311a5c-8839-4dc7-808f-323c6d2a619c@googlegroups.com...

> I told you previously that the hallmark of the
> ignormami is the use of the word "prove" to mean
> "provides supporting evidence for."
>
> Not very quick on the uptake, are you?
>
> I suppose that next you'll say that this post proves
> that I'm an idiot. lol

Sure, why not...  Let's try it:

The plural of "ignoramus" is "ignoramuses".  It's not "ignorami".

Even if "ignorami" was an accepted plural form of "ignoramus", you
still misspelled it: "ignor[m]ami"...

You used "use" when you meant "misuse".  The word "use" indicates
the usage is correct, but you stated the usage was incorrect
immediately afterwards.  The word "misuse" indicates the usage is
incorrect.  That's the word you really wanted.

No one has any idea why the "for" is there at the end of that
sentence: "blah blah ... for."  For what, exactly ... ?  It leaves
you hanging or dangling...

You used a rather awkward phrasing: "to mean 'provides ...'".  It's
like a pause, perhaps a comma, dash, or colon is needed.  Something
is missing inbetween "mean" and "provides".

In the original sentence: "Fortran proves Forth a stone-age toy,"
the word "prove" can be replaced by this phrase: "is evidence in
support of the belief that."  The phrase you posted for "prove"
doesn't work so well ...

You could've easily written an understandable sentence:
"I told you previously that the hallmark of ignoramuses is the
misuse of the word 'prove' to indicate: 'supporting evidence.'"


RP


[toc] | [prev] | [next] | [standalone]


#24430

FromRichard Owlett <rowlett@pcnetinc.com>
Date2013-07-12 05:14 -0500
Message-ID<af-dnbxuJLBqS0LMnZ2dnUVZ_oadnZ2d@supernews.com>
In reply to#24421
Rod Pemberton wrote:
> " "

Plonk

[toc] | [prev] | [standalone]


Back to top | Article view | comp.lang.forth


csiph-web