From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham autolearn_force=no version=3.4.4 X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 103376,efbbbab26bad9cb X-Google-Attributes: gid103376,public X-Google-ArrivalTime: 2003-06-18 02:32:14 PST Path: archiver1.google.com!news1.google.com!newsfeed.stanford.edu!logbridge.uoregon.edu!news.maxwell.syr.edu!wn14feed!wn13feed!worldnet.att.net!204.127.198.203!attbi_feed3!attbi.com!rwcrnsc53.POSTED!not-for-mail Message-ID: <3EF03178.9000908@attbi.com> From: "Robert I. Eachus" User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.0; en-US; rv:1.0.2) Gecko/20021120 Netscape/7.01 X-Accept-Language: en-us, en MIME-Version: 1.0 Newsgroups: comp.lang.ada Subject: Re: how to round integers (Figured it out!) References: <3EEE9C81.7030904@attbi.com> <3EEF6A62.5010809@spam.com> Content-Type: text/plain; charset=us-ascii; format=flowed Content-Transfer-Encoding: 7bit NNTP-Posting-Host: 24.62.164.137 X-Complaints-To: abuse@attbi.com X-Trace: rwcrnsc53 1055928733 24.62.164.137 (Wed, 18 Jun 2003 09:32:13 GMT) NNTP-Posting-Date: Wed, 18 Jun 2003 09:32:13 GMT Organization: AT&T Broadband Date: Wed, 18 Jun 2003 09:32:13 GMT Xref: archiver1.google.com comp.lang.ada:39383 Date: 2003-06-18T09:32:13+00:00 List-Id: Jeffrey Carter wrote: > Robert I. Eachus wrote: > >> function Rounding(Dividend, Divisor: Int) return Int is >> begin >> return (Dividend + Dividend + Divisor) / (Divisor + Divisor); >> exception >> when Constraint_Error => >> declare >> Temp: Int; >> begin >> Temp := Dividend rem Divisor; >> if Temp > Int'Last/2 or else Temp * 2 >= Divisor >> then return Dividend/Divisor + 1; >> -- Divisor is always less than or equal to Int'Last >> else return Dividend/Divisor; >> end if; >> end; >> end Rounding; >> >> function Round is new Rounding(Integer); > > > What happens in the case of negative arguments? Oops! New version for the new requirement. ;-) And if you think it is messy, it is, that is the nature of division, as Intel and others have found out. (It is actually the corner cases that are tricky--and you really have to test all of them.) Oh, the rounding is towards +inifinity, if you want anything else, you write it. Or modify this, it shouldn't be too hard. ----------------------------------------------------------------------- with Ada.Text_IO; use Ada.Text_IO; procedure Test_Rounding is generic type Int is range <>; function Rounding(Dividend, Divisor: Int) return Int; function Rounding(Dividend, Divisor: Int) return Int is begin if (Dividend >= 0 and Divisor > 0) or else (Dividend <= 0 and Divisor < 0) then return (Dividend + Dividend + Divisor) / (Divisor + Divisor); elsif Dividend <= 0 and Divisor > 0 then return (Dividend + Dividend - Divisor + 1) / (Divisor + Divisor); else return (Dividend + Dividend - Divisor - 1) / (Divisor + Divisor); end if; exception when Constraint_Error => if Divisor = 0 then raise Constraint_Error; end if; -- get the case we can't handle out of the way... declare Temp: Int; begin Temp := abs Dividend rem Divisor; if Divisor < 0 and Dividend > 0 then if Temp > -(Int'First/2) or else (Temp-1) * 2 >= -(Divisor + 1) then return Dividend/Divisor - 1; else return Dividend/Divisor; end if; elsif Divisor < 0 and Dividend < 0 then if Temp > -(Int'First/2) or else (Temp-1) * 2 >= -(Divisor + 2) then return Dividend/Divisor + 1; else return Dividend/Divisor; end if; elsif Divisor > 0 and Dividend > 0 then if Temp > Int'Last/2 or else Temp * 2 >= Divisor then return Dividend/Divisor + 1; else return Dividend/Divisor; end if; else -- Divisor > 0 and Dividend < 0 then if Temp > Int'Last/2 or else (Temp-1) * 2 >= Divisor - 1 then return Dividend/Divisor - 1; else return Dividend/Divisor; end if; end if; end; end Rounding; function Round is new Rounding(Integer); begin Put_Line(" Rounding (2,3) is " & Integer'Image(Round(2,3))); Put_Line(" Rounding (7,5) is " & Integer'Image(Round(7,5))); Put_Line(" Rounding (25, 10) is " & Integer'Image(Round(25,10))); Put_Line(" Rounding (1_000_000_000, 1_500_000_000) is " & Integer'Image(Round(1_000_000_000, 1_500_000_000))); Put_Line(" Rounding (1_000_000_000, 2_000_000_000) is " & Integer'Image(Round(1_000_000_000, 2_000_000_000))); Put_Line(" Rounding (1_500_000_000, 2_000_000_000) is " & Integer'Image(Round(1_500_000_000, 2_000_000_000))); Put_Line(" Rounding (1_000_000_000, 2_000_000_001) is " & Integer'Image(Round(1_00_000_000, 2_000_000_001))); Put_Line(" Rounding (1_500_000_000, Integer'Last) is " & Integer'Image(Round(1_500_000_000, Integer'Last))); Put_Line(" Rounding (1_073_741_824, Integer'Last) is " & Integer'Image(Round(1_073_741_824, Integer'Last))); Put_Line(" Rounding (1_073_741_823, Integer'Last) is " & Integer'Image(Round(1_073_741_823, Integer'Last))); Put_Line(" Rounding (1_000_000_000, Integer'Last) is " & Integer'Image(Round(1_000_000_000, Integer'Last))); Put_Line(" Rounding (-2,3) is " & Integer'Image(Round(-2,3))); Put_Line(" Rounding (-7,5) is " & Integer'Image(Round(-7,5))); Put_Line(" Rounding (-25, 10) is " & Integer'Image(Round(-25,10))); Put_Line(" Rounding (-1_000_000_000, 1_500_000_000) is " & Integer'Image(Round(-1_000_000_000, 1_500_000_000))); Put_Line(" Rounding (-1_000_000_000, 2_000_000_000) is " & Integer'Image(Round(-1_000_000_000, 2_000_000_000))); Put_Line(" Rounding (-1_500_000_000, 2_000_000_000) is " & Integer'Image(Round(-1_500_000_000, 2_000_000_000))); Put_Line(" Rounding (-1_000_000_000, 2_000_000_001) is " & Integer'Image(Round(-1_00_000_000, 2_000_000_001))); Put_Line(" Rounding (-1_500_000_000, Integer'Last) is " & Integer'Image(Round(-1_500_000_000, Integer'Last))); Put_Line(" Rounding (-1_073_741_824, Integer'Last) is " & Integer'Image(Round(-1_073_741_824, Integer'Last))); Put_Line(" Rounding (-1_073_741_823, Integer'Last) is " & Integer'Image(Round(-1_073_741_823, Integer'Last))); Put_Line(" Rounding (-1_000_000_000, Integer'Last) is " & Integer'Image(Round(-1_000_000_000, Integer'Last))); Put_Line(" Rounding (2,-3) is " & Integer'Image(Round(2,-3))); Put_Line(" Rounding (7,-5) is " & Integer'Image(Round(7,-5))); Put_Line(" Rounding (25, -10) is " & Integer'Image(Round(25,-10))); Put_Line(" Rounding (1_000_000_000, -1_500_000_000) is " & Integer'Image(Round(1_000_000_000, -1_500_000_000))); Put_Line(" Rounding (1_000_000_000, -2_000_000_000) is " & Integer'Image(Round(1_000_000_000, -2_000_000_000))); Put_Line(" Rounding (1_500_000_000, -2_000_000_000) is " & Integer'Image(Round(1_500_000_000, -2_000_000_000))); Put_Line(" Rounding (1_000_000_000, -2_000_000_001) is " & Integer'Image(Round(1_00_000_000, -2_000_000_001))); Put_Line(" Rounding (1_500_000_000, Integer'First) is " & Integer'Image(Round(1_500_000_000, Integer'First))); Put_Line(" Rounding (1_073_741_824, Integer'First) is " & Integer'Image(Round(1_073_741_824, Integer'First))); Put_Line(" Rounding (1_073_741_823, Integer'First) is " & Integer'Image(Round(1_073_741_823, Integer'First))); Put_Line(" Rounding (1_000_000_000, Integer'First) is " & Integer'Image(Round(1_000_000_000, Integer'First))); Put_Line(" Rounding (-2,-3) is " & Integer'Image(Round(-2,-3))); Put_Line(" Rounding (-7,-5) is " & Integer'Image(Round(-7,-5))); Put_Line(" Rounding (-25,-10) is " & Integer'Image(Round(-25,-10))); Put_Line(" Rounding (-1_000_000_000, -1_500_000_000) is " & Integer'Image(Round(-1_000_000_000, -1_500_000_000))); Put_Line(" Rounding (-1_000_000_000, -2_000_000_000) is " & Integer'Image(Round(-1_000_000_000, -2_000_000_000))); Put_Line(" Rounding (-1_500_000_000, -2_000_000_000) is " & Integer'Image(Round(-1_500_000_000, -2_000_000_000))); Put_Line(" Rounding (-1_000_000_000, -2_000_000_001) is " & Integer'Image(Round(-1_000_000_000, -2_000_000_001))); Put_Line(" Rounding (-1_500_000_000, Integer'First) is " & Integer'Image(Round(-1_500_000_000, Integer'First))); Put_Line(" Rounding (-1_073_741_824, Integer'First) is " & Integer'Image(Round(-1_073_741_824, Integer'First))); Put_Line(" Rounding (-1_073_741_823, Integer'First) is " & Integer'Image(Round(-1_073_741_823, Integer'First))); Put_Line(" Rounding (-1_000_000_000, Integer'First) is " & Integer'Image(Round(-1_000_000_000, Integer'First))); end Test_Rounding; ----------------------------------------------------------------------- The tests should probably be rewritten to only print results if there is a problem... E:\Ada\Bug>test_rounding test_rounding Rounding (2,3) is 1 Rounding (7,5) is 1 Rounding (25, 10) is 3 Rounding (1_000_000_000, 1_500_000_000) is 1 Rounding (1_000_000_000, 2_000_000_000) is 1 Rounding (1_500_000_000, 2_000_000_000) is 1 Rounding (1_000_000_000, 2_000_000_001) is 0 Rounding (1_500_000_000, Integer'Last) is 1 Rounding (1_073_741_824, Integer'Last) is 1 Rounding (1_073_741_823, Integer'Last) is 0 Rounding (1_000_000_000, Integer'Last) is 0 Rounding (-2,3) is -1 Rounding (-7,5) is -1 Rounding (-25, 10) is -2 Rounding (-1_000_000_000, 1_500_000_000) is -1 Rounding (-1_000_000_000, 2_000_000_000) is 0 Rounding (-1_500_000_000, 2_000_000_000) is -1 Rounding (-1_000_000_000, 2_000_000_001) is 0 Rounding (-1_500_000_000, Integer'Last) is -1 Rounding (-1_073_741_824, Integer'Last) is -1 Rounding (-1_073_741_823, Integer'Last) is 0 Rounding (-1_000_000_000, Integer'Last) is 0 Rounding (2,-3) is -1 Rounding (7,-5) is -1 Rounding (25, -10) is -2 Rounding (1_000_000_000, -1_500_000_000) is -1 Rounding (1_000_000_000, -2_000_000_000) is 0 Rounding (1_500_000_000, -2_000_000_000) is -1 Rounding (1_000_000_000, -2_000_000_001) is 0 Rounding (1_500_000_000, Integer'First) is -1 Rounding (1_073_741_824, Integer'First) is 0 Rounding (1_073_741_823, Integer'First) is 0 Rounding (1_000_000_000, Integer'First) is 0 Rounding (-2,-3) is 1 Rounding (-7,-5) is 1 Rounding (-25,-10) is 3 Rounding (-1_000_000_000, -1_500_000_000) is 1 Rounding (-1_000_000_000, -2_000_000_000) is 1 Rounding (-1_500_000_000, -2_000_000_000) is 1 Rounding (-1_000_000_000, -2_000_000_001) is 0 Rounding (-1_500_000_000, Integer'First) is 1 Rounding (-1_073_741_824, Integer'First) is 1 Rounding (-1_073_741_823, Integer'First) is 0 Rounding (-1_000_000_000, Integer'First) is 0