comp.lang.ada
 help / color / mirror / Atom feed
From: csus.edu!wupost!cs.utexas.edu!sun-barr!cronkite.Central.Sun.COM!newstop!s unaus!assip.csasyd!condor!daves@ucdavis.ucdavis.edu  (Dave Smart)
Subject: Re: Red-faced professor gets bitten in search for portability
Date: 20 Nov 91 02:55:01 GMT	[thread overview]
Message-ID: <daves.690605701@condor> (raw)

In <1991Nov16.000120.25606@milton.u.washington.edu> mfeldman@milton.u.washingto
n.edu (Michael Feldman) writes:

> In article <11919@spim.mips.COM> murphy@mips.com (Mike Murphy) writes:
> >
> >You are right about your first version not being portable, but
> >your second version seems a bit convulated to me.  Why not just
> >check whether you indeed rounded down after doing the integer conversion?
> >For example:
> >	FUNCTION Trunc (X: Float) RETURN Integer IS
> >		itrunc : integer = integer(x - 0.5);
> >	BEGIN
> >		if x - float(itrunc) >= 1.0 then
> >			-- rounded down, so add back a 1
> >			return itrunc+1;
> >		else
> >			return itrunc;
> >		end if;
> >	END Trunc;
> Sure - this seems equivalent. I kinda like the halving and doubling,
> because these are pretty fast to implement (as shifts) given a
> good optimizer. Your method has the advantage, I suppose, of being immune
> to a possible overflow from the doubling.

This code works (after fixing the syntax error).  Yours doesn't, Mike.

Your

  FUNCTION Trunc (X: Float) RETURN Integer IS
  BEGIN
    RETURN Integer(2.0 * X) / 2;
  END Trunc;

still takes the integer before the division.  In fact, as you've now doubled th
e
number, the horrible rounding beast is twice as active (i.e. 0.25 and 0.75
both fall victim).

I think Mike Murphy's code looks awkward because it's sort of upside down.  The
 
problem can be restated as: "if integer () rounds up, return one less than the
value of integer (), otherwise return the value of integer ()".

This translates to:

  function trunc (number: float) return integer is
  begin
    if float (integer (number)) > number then  -- does it round up?
      return integer (number) - 1;             -- yes - stop it!
    else
      return integer (number);                 -- no - ok as it is.
    end if;
  end trunc;

(I'm assuming that my compiler is clever enough to eliminate the redundant conv
ersions to integer.)

Dave

>From here down - my program which checks out all four trunc functions:

--------------------------------
with integer_io; use integer_io;
with text_io; use text_io;

procedure x is

package floating_io is new float_io (float); use floating_io;

r: float;
check: integer;
error,
first: boolean;

  FUNCTION Trunc_mf1 (X: Float) RETURN Integer IS
  BEGIN
    RETURN Integer(X - 0.5);
  END Trunc_mf1;

  FUNCTION Trunc_mf2 (X: Float) RETURN Integer IS
  BEGIN
    RETURN Integer(2.0 * X) / 2;
  END Trunc_mf2;

  FUNCTION Trunc_mm1 (X: Float) RETURN Integer IS
          itrunc : integer := integer(x - 0.5);
  BEGIN
    if x - float(itrunc) >= 1.0 then
      return itrunc+1; -- rounded down, so add back a 1
    else
      return itrunc;
    end if;
  END Trunc_mm1;
  
  function trunc_ds1 (number: float) return integer is
  begin
    if float (integer (number)) > number then  -- does it round up?
      return integer (number) - 1;             -- yes - stop it!
    else
      return integer (number);                 -- no - ok as it is.
    end if;
  end trunc_ds1;

  procedure try (message: string; value: integer) is
  begin
    put (" " & message & " => ");
    put (value, 2);
    if first then
      check := value;
      first := false;
    elsif check /= value then
      error := true;
    end if;
  end try;

begin -- x

  r := -5.0;
  loop
    put (r, 3, 2, 0);
    first := true;
    error := false;
    try ("mf1", trunc_mf1 (r));
    try ("mf2", trunc_mf2 (r));
    try ("mm1", trunc_mm1 (r));
    try ("ds1", trunc_ds1 (r));
    if error then
      put ("     ******");
    end if;
    new_line;
    r := r + 0.25;
    exit when r > 5.0;
  end loop;
  
end;
----------------------------

-- 
David Smart, Computer Sciences of Australia.
Net: daves@assip.csasyd.oz.au

             reply	other threads:[~1991-11-20  2:55 UTC|newest]

Thread overview: 13+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
1991-11-20  2:55 csus.edu!wupost!cs.utexas.edu!sun-barr!cronkite.Central.Sun.COM!newstop!s [this message]
  -- strict thread matches above, loose matches on Subject: below --
1991-11-25  6:09 Red-faced professor gets bitten in search for portability csus.edu!wupost!spool.mu.edu!munnari.oz.au!metro!cluster!swift!sunaus!ass
1991-11-22 22:16 Dik T. Winter
1991-11-22 22:11 Dik T. Winter
1991-11-22 21:10 Jonathan Parker
1991-11-22 15:24 The Sunset Kid
1991-11-22 14:06 psinntp!vitro.com!v7.vitro.com!vaxs09
1991-11-22  2:29 micro-heart-of-gold.mit.edu!wupost!zaphod.mps.ohio-state.edu!uakari.prima
1991-11-20 23:59 micro-heart-of-gold.mit.edu!wupost!sdd.hp.com!uakari.primate.wisc.edu!use
1991-11-19 15:06 Norman H. Cohen
1991-11-16  0:01 Michael Feldman
1991-11-15 20:58 Mike Murphy
1991-11-15 18:59 Michael Feldman
replies disabled

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox