//
// 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

//