Deutsch   English   Français   Italiano  
<28fcb29094fab35007403391b3ea764e@www.novabbs.com>

View for Bookmarking (what is this?)
Look up another Usenet article

Path: ...!weretis.net!feeder9.news.weretis.net!news.nk.ca!rocksolid2!i2pn2.org!.POSTED!not-for-mail
From: mhx@iae.nl (mhx)
Newsgroups: comp.lang.forth
Subject: Re: Complex square root of -1 : zsqrt(-1)
Date: Wed, 28 Aug 2024 21:42:15 +0000
Organization: novaBBS
Message-ID: <28fcb29094fab35007403391b3ea764e@www.novabbs.com>
References: <cc2a1ec5eae8d18d290b398af3c013cb@www.novabbs.com> <2024Aug25.191346@mips.complang.tuwien.ac.at> <c02b8db68bf735b5c30c7d5979b942a3@www.novabbs.com> <2024Aug28.103612@mips.complang.tuwien.ac.at> <20540ab199e43e94b3d156a1dd58e3f2@www.novabbs.com> <d9184f7688ceced53b41535c172032b3@www.novabbs.com> <f55b068b628dc4c5ae64a7d71d87c964@www.novabbs.com> <a886e3f176a33b9a041d8b36fea3916e@www.novabbs.com> <df1eb1782e95ac101f5ca81ff81f1e32@www.novabbs.com>
MIME-Version: 1.0
Content-Type: text/plain; charset=utf-8; format=flowed
Content-Transfer-Encoding: 8bit
Injection-Info: i2pn2.org;
	logging-data="69531"; mail-complaints-to="usenet@i2pn2.org";
	posting-account="t0bSWFIQDvYvkkhDiPIIv6byulC6WbSEwXWMJpxc4k0";
User-Agent: Rocksolid Light
X-Spam-Checker-Version: SpamAssassin 4.0.0
X-Rslight-Site: $2y$10$I6xEov0BfI94yvHjNeIRieNWHOjUrFJuFrattzlGccDuq/WEtymd.
X-Rslight-Posting-User: 59549e76d0c3560fb37b97f0b9407a8c14054f24
Bytes: 2194
Lines: 25

On Wed, 28 Aug 2024 19:49:02 +0000, ahmed wrote:

> Another definition for |z|
>
> : |z| ( z: a+ib -- m) ( f: a b--m)
> fover fabs fover fabs ( f: a b |a| |b|)
> fmax                  ( f: a b mx)
> frot frot             ( f: mx a b)
> fover fabs fover fabs fmax ( f: mx a b mx)
> ftuck                      ( f: mx a mx b mx)
> f/                         ( f: mx a mx b/mx)
> fdup f* frot frot          ( f: mx [b/mx]^2 a mx)
> f/ fdup f* f+ fsqrt f* ;

How about
: xpythag ( F: a b -- c )	\ compute sqrt(a^2+b^2) without overflow
	FABS FSWAP FABS FSWAP
	F2DUP F> IF  FOVER ( F: a b a -- ) F/ FSQR F1+ FSQRT  F*  EXIT  ENDIF
	FDUP F0= IF  0e
	       ELSE  FTUCK ( F: b a b -- ) F/ FSQR F1+ FSQRT  F*
	      ENDIF ;

FORTH> 1e-309 0e xpythag +e.  1.0000000000000000000e-0309 ok
FORTH> 1e-319 0e xpythag +e.  9.9999999999999999992e-0320 ok

-marcel