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


Groups > comp.lang.forth > #21461

Re: Anonymous code/data/create-does

From mhx@iae.nl (Marcel Hendrix)
Subject Re: Anonymous code/data/create-does
Newsgroups comp.lang.forth
Message-ID <97631597998434@frunobulax.edu> (permalink)
Date 2013-04-06 20:40 +0200
References <18061599998434@frunobulax.edu>
Organization Wanadoo

Show all headers | View raw


Here is small application using the ANONS package from my previous posting.

I solve the pde1 Electrostatics Boundary-Value Problem given by Krishna Myneni 
in five possible ways: 

 1) One noname for every array entry, executed sequentially
 1) One anon for every array entry, executed sequentially
 2) One anon for every array entry, executed in 4 parallel threads
 3) Four big noname: defs that process 25% of the data serially
 4) The same four noname: defs processing in 4 parallel threads

( Windows 7 )
solve0 : noname (1)       : after 4971 iterations and 0.551 seconds elapsed.
solve1 : anons (1)        : after 4971 iterations and 0.520 seconds elapsed.
solve2 : parallel anons   : after 4972 iterations and 1.250 seconds elapsed.
solve3 : nonames          : after 4971 iterations and 0.172 seconds elapsed.
solve4 : parallel nonames : after 4973 iterations and 1.243 seconds elapsed. ok

( Linux Ubuntu 12.4 )
solve0 : noname (1)       : after 4971 iterations and 0.431 seconds elapsed.
solve1 : anons (1)        : after 4971 iterations and 0.412 seconds elapsed.
solve2 : parallel anons   : after 4972 iterations and 0.542 seconds elapsed.
solve3 : nonames          : after 4971 iterations and 0.140 seconds elapsed.
solve4 : parallel nonames : after 4973 iterations and 0.140 seconds elapsed. ok

There is no significant difference between a NONAME: and an anonymous definition.

On Windows the threaded version is many times slower than the serial one, on 
Linux it makes no difference. This is probably because the four threads need 
to access the same memory locations quite frequently. It is a pity, the syntax 
with the anons is quite nice.

Interestingly, it is not possible to see a time difference between the
threaded versions. I also noted that (both on Windows and Linux) the runtime 
(unpredictably) varies by a factor of two (lowest shown).

-marcel

-- --------------------------------------------------------------------------
(*
 * LANGUAGE    : ANS Forth with extensions
 * PROJECT     : Forth Environments
 * DESCRIPTION : PDE solver
 * CATEGORY    : Example 
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : Saturday, April 06, 2013, 19:13, Marcel Hendrix 
 *)


	NEEDS -miscutil
	NEEDS -threads
	NEEDS -anons

	REVISION -pde6 "--- PDE solver          Version 1.02 ---"

#64         =: /GRID PRIVATE
/GRID DUP * =: /sz   PRIVATE

1e-3  FVALUE           ftol
100e  FCONSTANT    TOP_EDGE
1e-20 FCONSTANT  RIGHT_EDGE
1e-20 FCONSTANT BOTTOM_EDGE
 50e  FCONSTANT   LEFT_EDGE

CREATE xts  PRIVATE  /sz CELLS  ALLOT -- children
CREATE xts2 PRIVATE  /sz CELLS  ALLOT -- nonames
CREATE grid PRIVATE  /sz FLOATS ALLOT -- Rectangular Region Boundary Values

: >mat ( r c -- addr ) SWAP /GRID * + grid []FLOAT ; PRIVATE
: fillrow    ( F: r -- ) ( row -- ) LOCAL row  /GRID 0 DO  FDUP row I >mat F!  LOOP FDROP ;
: fillcolumn ( F: r -- ) ( col -- ) LOCAL col  /GRID 0 DO  FDUP I col >mat F!  LOOP FDROP ;

-- Setup rectangular boundary values
: set-boundaries ( -- )
	grid /sz FLOATS ERASE 
	   TOP_EDGE  0        fillrow
	BOTTOM_EDGE  /GRID 1- fillrow
	 RIGHT_EDGE  /GRID 1- fillcolumn
	  LEFT_EDGE  0        fillcolumn ;

-- Apply the mean value theorem once to each of the interior grid values:
-- Replace each grid value with the average of the four nearest neighbor values.

: nearsum ( addr -- ) ( F: -- wsum )
	>R
	R@ FLOAT-         F@    \ left nearest neighbor
	R@ FLOAT+         F@ F+ \ right nearest neighbor
	R@ /GRID FLOATS - F@ F+ \ up nearest neighbor
	R@ /GRID FLOATS + F@ F+ \ down nearest neighbor
	   F2/ F2/ FDUP
	R> F! ; PRIVATE

:NONAME ( -- )  
	0 0 0 LOCALS| addr boundary interior |
	set-boundaries
	[: @ F@      ;] TO boundary
	[: @ nearsum ;] TO interior
	grid  /sz 
	0 ?DO  	TO addr 
		addr F@+ F0= IF  interior  ELSE  boundary  ENDIF 
		^, addr , ( addr2 xt-child -- )  xts I CELL[] !
	 LOOP	DROP ; EXECUTE 

:NONAME ( -- )  
	/sz 0 ?DO :NONAME 
		    grid I FLOAT[] DUP
		    F@ F0= IF  ]] LITERAL nearsum [[ ( interior )
		         ELSE  ]] LITERAL F@      [[ ( boundary ) 
		        ENDIF 
		  POSTPONE ;  xts2 I CELL[] !
	     LOOP ; EXECUTE

: ,part ( high low -- xt )  
	LOCALS| lo hi |
	:NONAME 0e ]] FLITERAL [[
	hi lo 
	  ?DO  	grid I FLOAT[] DUP
		F@ F0= IF  ]] LITERAL nearsum F+ [[ ( interior )
		     ELSE  ]] LITERAL F@      F+ [[ ( boundary ) 
		    ENDIF 
	 LOOP 
	POSTPONE ; ; 
	
:NONAME ( -- )
	set-boundaries
	/sz 4 /             0  ,part
	/sz 2/        /sz 4 /  ,part
	/sz 3 4 */     /sz 2/  ,part
	/sz        /sz 3 4 */  ,part
	; EXECUTE =: altxt3 =: altxt2 =: altxt1 =: altxt0 

-- solutions ------------------------------------------------------------------------------------

: iterate0 ( F: -- sum ) 0e  /sz 0 ?DO  xts2 I CELL[] PERFORM F+  LOOP ; PRIVATE
: iterate1 ( F: -- sum ) 0e  /sz 0 ?DO  xts  I CELL[] PERFORM F+  LOOP ; PRIVATE

0e FVALUE sum PRIVATE

: iterate2 ( F: -- sum ) 
	0e TO sum 
	PAR
	  STARTP  0e /sz 4 /             0 ?DO  xts I CELL[] PERFORM F+  LOOP +TO sum  ENDP
	  STARTP  0e /sz 2/        /sz 4 / ?DO  xts I CELL[] PERFORM F+  LOOP +TO sum  ENDP
	  STARTP  0e /sz 3 4 */     /sz 2/ ?DO  xts I CELL[] PERFORM F+  LOOP +TO sum  ENDP
	  STARTP  0e /sz        /sz 3 4 */ ?DO  xts I CELL[] PERFORM F+  LOOP +TO sum  ENDP
	ENDPAR
	sum ; PRIVATE

: iterate3 ( F: -- sum ) 
	0e TO sum
	  altxt0 EXECUTE +TO sum
	  altxt1 EXECUTE +TO sum
	  altxt2 EXECUTE +TO sum
	  altxt3 EXECUTE +TO sum
	sum ; PRIVATE

: iterate4 ( F: -- sum ) 
	0e TO sum
	PAR
	  STARTP  altxt0 EXECUTE +TO sum  ENDP
	  STARTP  altxt1 EXECUTE +TO sum  ENDP
	  STARTP  altxt2 EXECUTE +TO sum  ENDP
	  STARTP  altxt3 EXECUTE +TO sum  ENDP
	ENDPAR sum ; PRIVATE

: (solve) ( xt -- #iters ) 
	+INF FLOCAL prev
	1 LOCALS| #iters xt |
	set-boundaries
	BEGIN  xt EXECUTE FDUP prev F- FABS ftol F> 
	WHILE  TO prev  1 +TO #iters
	REPEAT FDROP #iters ; PRIVATE

: solve0 ( -- ) ['] iterate0 (solve) ." noname (1)       : " ;
: solve1 ( -- ) ['] iterate1 (solve) ." anons (1)        : " ;
: solve2 ( -- ) ['] iterate2 (solve) ." parallel anons   : " ;
: solve3 ( -- ) ['] iterate3 (solve) ." nonames          : " ;
: solve4 ( -- ) ['] iterate4 (solve) ." parallel nonames : " ;

-- display and test -----------------------------------------------------------------------------------

-- Find min and max of grid values 
: sizes ( F: -- fmin fmax ) 
	0e 0e FLOCALS| =max =min |
	grid /sz 0 ?DO	F@+ FDUP  =max FMAX TO =max  =min FMIN TO =min  LOOP 
	DROP =min =max ; PRIVATE

-- display the grid values as a character map 
: .grid ( -- ) 
	sizes F2DUP FSWAP F- 15e FSWAP F/ FLOCALS| =scale =max =min |  
	TextBGColor LOCAL obgc
	grid
	/GRID  0 ?DO CR  /GRID  0 ?DO  	F@+ =min F- =scale F* FROUND F>S 
					TO TextBGColor SetTerm SPACE
			 	 LOOP
	        LOOP DROP 
	obgc TO TextBGColor SetTerm ;

: BENCH ( -- ) 
	TIMER-RESET CR ." solve0 : " solve0 ." after " DEC. ." iterations and " .ELAPSED 
	TIMER-RESET CR ." solve1 : " solve1 ." after " DEC. ." iterations and " .ELAPSED 
	TIMER-RESET CR ." solve2 : " solve2 ." after " DEC. ." iterations and " .ELAPSED 
	TIMER-RESET CR ." solve3 : " solve3 ." after " DEC. ." iterations and " .ELAPSED 
	TIMER-RESET CR ." solve4 : " solve4 ." after " DEC. ." iterations and " .ELAPSED ;

:ABOUT	CR ." Numerical Solution of Electrostatics Boundary-Value Problems " 
	CR 
	/GRID DUP 3 .R 'x' EMIT . ." grid has been setup. Type:"
	CR ."   solvei . -- to find the solution and print number of iterations (i=1,2,3,4)"
	CR ."   .grid    -- to view grid as a character map" 
	CR ."   ftol     -- fvalue setting the wanted accuracy ( " ftol E. ." )" ;

		.ABOUT -pde6 CR
		DEPRIVE

				(* End of Source *)

Back to comp.lang.forth | Previous | NextPrevious in thread | Next in thread | Find similar


Thread

Anonymous code/data/create-does mhx@iae.nl (Marcel Hendrix) - 2013-04-02 23:46 +0200
  Re: Anonymous code/data/create-does "WJ" <w_a_x_man@yahoo.com> - 2013-04-02 22:51 +0000
  Re: Anonymous code/data/create-does "WJ" <w_a_x_man@yahoo.com> - 2013-04-02 23:00 +0000
  Re: Anonymous code/data/create-does Gerry Jackson <gerry@jackson9000.fsnet.co.uk> - 2013-04-03 11:07 +0100
    Re: Anonymous code/data/create-does m.a.m.hendrix@tue.nl - 2013-04-03 06:53 -0700
      Re: Anonymous code/data/create-does Alex McDonald <blog@rivadpm.com> - 2013-04-03 13:43 -0700
        Re: Anonymous code/data/create-does Gerry Jackson <gerry@jackson9000.fsnet.co.uk> - 2013-04-04 18:07 +0100
    Re: Anonymous code/data/create-does mhx@iae.nl (Marcel Hendrix) - 2013-04-04 00:38 +0200
      Re: Anonymous code/data/create-does Gerry Jackson <gerry@jackson9000.fsnet.co.uk> - 2013-04-04 18:18 +0100
        Re: Anonymous code/data/create-does mhx@iae.nl (Marcel Hendrix) - 2013-04-04 20:29 +0200
          Re: Anonymous code/data/create-does mhx@iae.nl (Marcel Hendrix) - 2013-04-06 20:40 +0200
            Re: Anonymous code/data/create-does Alex McDonald <blog@rivadpm.com> - 2013-04-06 14:09 -0700
              Re: Anonymous code/data/create-does mhx@iae.nl (Marcel Hendrix) - 2013-04-07 02:04 +0200
                Re: Anonymous code/data/create-does Alex McDonald <blog@rivadpm.com> - 2013-04-06 20:34 -0700
                Re: Anonymous code/data/create-does mhx@iae.nl (Marcel Hendrix) - 2013-04-07 14:00 +0200
                Re: Anonymous code/data/create-does kenney@cix.compulink.co.uk - 2013-04-08 02:38 -0500
                Re: Anonymous code/data/create-does Roelf Toxopeus <rt4all@notthis.hetnet.nl> - 2013-04-08 10:58 +0200
                Re: Anonymous code/data/create-does Alex McDonald <blog@rivadpm.com> - 2013-04-08 14:57 -0700
                Re: Anonymous code/data/create-does Bernd Paysan <bernd.paysan@gmx.de> - 2013-04-08 19:26 +0200
                Re: Anonymous code/data/create-does kenney@cix.compulink.co.uk - 2013-04-09 02:07 -0500
  Re: Anonymous code/data/create-does mhx@iae.nl (Marcel Hendrix) - 2013-04-03 22:44 +0200
    Re: Anonymous code/data/create-does Lars Brinkhoff <lars.spam@nocrew.org> - 2013-04-04 12:42 +0200
      Re: Anonymous code/data/create-does Andrew Haley <andrew29@littlepinkcloud.invalid> - 2013-04-04 07:04 -0500
        Re: Anonymous code/data/create-does Andrew Haley <andrew29@littlepinkcloud.invalid> - 2013-04-04 07:07 -0500

csiph-web