RosettaCodeData/Task/Arithmetic-Rational/FutureBasic/arithmetic-rational.basic
2026-04-30 12:34:36 -04:00

315 lines
7.9 KiB
Text

//
// Arithmetic / Rational
//
// Using FutureBasic 7.0.34
// August 2025, R.W.
//
//--------------------------
// Fraction Structure
//--------------------------
begin record FRCT
double num
double den
end record
//--------------------------------
// Helper: Greatest Common Factor
//--------------------------------
local fn GCF( a as Int, b as Int ) as long
a = abs(a) : b = abs(b)
while b <> 0
dim as long temp = b
b = a mod b
a = temp
wend
end fn = a
//-----------------------------------------
// Helper: Reduce fraction to lowest terms
//-----------------------------------------
local fn ReduceFrct( f as FRCT ) as FRCT
dim g as long
if f.den = 0 then f.den = 1
g = fn GCF( f.num, f.den )
if g > 1
f.num = f.num / g
f.den = f.den / g
end if
// Check denominator
if f.den < 0
f.num = -f.num
f.den = -f.den
end if
end fn = f
//---------------------------------------
// Helper: Normalize fraction (sign only)
//----------------------------------------
local fn NormalizeFrct(n as double, d as double) as FRCT
FRCT f
if d = 0 then d = 1
if d < 0 then n = -n : d = -d
f.num = n
f.den = d
// if you DON'T wish to reduce the fraction
// just comment out the next line
f = fn ReduceFrct(f)
end fn = f
//---------------------
// Helper: Constructor
//---------------------
local fn NewFrct(n as double, d as double) as FRCT
FRCT f
f = fn NormalizeFrct(n, d)
end fn = f
//----------------------------------
// Helper: Display the output result
//----------------------------------
local fn PrintFrct(f as FRCT) as CFStringRef
CFStringRef result, tmp, tmp2
result = @"":tmp = @"": tmp2 = @""
if f.den = 1
tmp = mid(str(f.num),1)
result = concat(result,tmp)
else
if f.num >0 then tmp = mid(str(f.num),1) else tmp = str(f.num)
if f.den >0 then tmp2 = mid(str(f.den),1) else tmp2 = str(f.den)
result = concat(result, tmp, @"/", tmp2)
end if
end fn = result
//---------------------------
// Fraction Suite: operations
//---------------------------
// Add
local fn AddFrct(a as FRCT, b as FRCT) as FRCT
FRCT f
f = fn NormalizeFrct(a.num*b.den + b.num*a.den, a.den*b.den)
end fn = f
// Subtract
local fn SubFrct(a as FRCT, b as FRCT) as FRCT
FRCT f
f = fn NormalizeFrct(a.num*b.den - b.num*a.den, a.den*b.den)
end fn = f
// Multiply
local fn MulFrct(a as FRCT, b as FRCT) as FRCT
FRCT f
f = fn NormalizeFrct(a.num*b.num, a.den*b.den)
end fn = f
// Divide
local fn DivFrct(a as FRCT, b as FRCT) as FRCT
FRCT f
f = fn NormalizeFrct(a.num*b.den, a.den*b.num)
end fn = f
// Negate
local fn NegFrct(r as FRCT) as FRCT
FRCT f
f.num = -r.num
f.den = r.den
end fn = f
// Modulo (a mod b)
local fn ModFrct(a as FRCT, b as FRCT) as FRCT
FRCT f
double numeratorMul, denominatorMul
long intPart
// Compute cross-multiplied numerator and denominator
numeratorMul = a.num * b.den
denominatorMul = b.num * a.den
if numeratorMul / denominatorMul >= 0
intPart = fix(numeratorMul / denominatorMul)
else
intPart = fix(numeratorMul / denominatorMul) - 1
end if
// Remainder numerator
f.num = numeratorMul - intPart * denominatorMul
f.den = a.den * b.den
// Reduce fraction to lowest terms
f = fn ReduceFrct(f)
end fn = f
//----------------------------
// Fraction Suite: comparisons
//----------------------------
// = Equal
local fn EqFrct(a as FRCT, b as FRCT) as Boolean
end fn = (a.num == b.num) && (a.den == b.den)
// <> Not Equal
local fn NeFrct(a as FRCT, b as FRCT) as Boolean
end fn = ! fn EqFrct(a,b)
// < Less than
local fn LtFrct(a as FRCT, b as FRCT) as Boolean
dim f as FRCT
f = fn SubFrct(a, b)
end fn = (f.num < 0)
// > Greater than
local fn GtFrct(a as FRCT, b as FRCT) as Boolean
dim f as FRCT
f = fn SubFrct(a, b)
end fn = (f.num > 0)
// <= Less or Equal to
local fn LeFrct(a as FRCT, b as FRCT) as Boolean
dim f as FRCT
f = fn SubFrct(a, b)
end fn = (f.num <= 0)
// >= Greater or Equal to
local fn GeFrct(a as FRCT, b as FRCT) as Boolean
dim f as FRCT
f = fn SubFrct(a, b)
end fn = (f.num >= 0)
//--------------------------
// Absolute and inverse
//--------------------------
local fn AbsFrct(r as FRCT) as FRCT
dim f as FRCT
f.num = abs(r.num)
f.den = r.den
end fn = f
//--------------------------
// Inverse
//--------------------------
local fn InvFrct(r as FRCT) as FRCT
dim f as FRCT
f.num = r.den
f.den = r.num
end fn = f
// TEST DATA
//-----------------------------
// Test the A-R suite functions
//-----------------------------
void local fn TestSuite
dim frct1 as FRCT
dim frct2 as FRCT
dim result as FRCT
double numerator, denominator
// construct the fractions
// 1/4 and 1/2
numerator = 1
denominator = 4
frct1 = fn NewFrct (numerator,denominator)
numerator = 1
denominator = 2
frct2 = fn NewFrct (numerator,denominator)
print @"Fractions Ops"
print @"-------------"
result = fn AddFrct(frct1,frct2)
print@ "Addition 1/4 + 1/2 = ";fn PrintFrct(result)
result = fn SubFrct(frct2,frct1)
print@ "Subtraction 1/2 - 1/4 = ";fn PrintFrct(result)
result = fn MulFrct(frct1,frct2)
print@ "Multiplication 1/2 * 1/4 = ";fn PrintFrct(result)
result = fn DivFrct(frct2,frct1)
print@ "Division 1/2 / 1/4 = ";fn PrintFrct(result)
frct1 = fn NewFrct(7,3)
frct2 = fn NewFrct(2,3)
result = fn ModFrct(frct1, frct2)
print@ "Mod 7/3 % 2/3 = ";fn PrintFrct(result)
result = fn NegFrct(frct1)
print@ "Neg 7/3 = ";fn PrintFrct(result)
print@
print @"Fractions Comparison"
print @"--------------------"
if fn EqFrct(frct1,frct2) then print fn PrintFrct(frct1); ¬
@" is == ";fn PrintFrct(frct2)
if fn NeFrct(frct1,frct2) then print fn PrintFrct(frct1); ¬
@" is != ";fn PrintFrct(frct2)
if fn GtFrct(frct1,frct2) then print fn PrintFrct(frct1); ¬
@" is > ";fn PrintFrct(frct2)
if fn LtFrct(frct1,frct2) then print fn PrintFrct(frct1); ¬
@" is < ";fn PrintFrct(frct2)
if fn LeFrct(frct1,frct2) then print fn PrintFrct(frct1); ¬
@" is <= ";fn PrintFrct(frct2)
if fn GeFrct(frct1,frct2) then print fn PrintFrct(frct1); ¬
@" is >= ";fn PrintFrct(frct2)
print@
print @"Absolute and Inverse"
print @"--------------------"
numerator = -1
denominator = 2
frct2 = fn NewFrct (numerator,denominator)
result = fn AbsFrct(frct2)
print@ "Abs (1/-2) = ";fn PrintFrct(result) //result.num;"/"result.den
result = fn InvFrct(frct2)
print@ "Inv (1/-2) = ";fn PrintFrct(result) //result.num;"/"result.den
end fn
//
// Lucas-Lehmer Perfect Number
// (2^n) * ((2^(n + 1))-1)
local fn isPerfect2(n as double) As Boolean
if ( n < 2 ) then return _False
if ( n mod 2 == 1 ) then return _False
Boolean result
double sum, f, i
f = 1: i = 1: sum = 1
for i = 2 to sqr(n)
if ( n mod i == 0 )
sum = sum + i
f = fix(n / i)
if ( f > i ) then sum = sum + f
end if
next
result = (sum == n)
end fn = result
//--------------------------
// Main routine
//--------------------------
window 1
// start the clock
CFTimeInterval t
t = fn CACurrentMediaTime
fn TestSuite
// stop the clock
print @
printf @"Test Suite completed in %.4f seconds.", (fn CACurrentMediaTime - t)
t = fn CACurrentMediaTime
print@
_max = 2^19
print @"Finding Lucas-Lehmer Perfect Numbers"
print @"from 2 to ";_max
print @
print "Perfect Numbers < 2^19"
print "----------------------"
for double i = 2 to _max
if fn isPerfect2(i) then print @i; " is perfect."
next i
// do the 5th, 6th, and 7th Perfect Number
print @
print @"The 5th, 6th, and 7th Perfect Numbers"
print @"-------------------------------------"
double pn5_7
pn5_7 = (2^12) * ((2^13)-1)
if fn IsPerfect2(pn5_7) then print pn5_7;" is perfect."
pn5_7 = (2^16) * ((2^17)-1)
if fn IsPerfect2(pn5_7) then print pn5_7;" is perfect."
pn5_7 = (2^18) * ((2^19)-1)
if fn IsPerfect2(pn5_7) then print pn5_7;" is perfect."
// stop the clock
print @
printf @"Perfect numbers completed in %.4f seconds.", (fn CACurrentMediaTime - t)
handleEvents
//