Data update

Task/Arithmetic-Rational/Crystal/arithmetic-rational.cr

@@ -0,0 +1,110 @@
+struct Int
+  def to_frac
+    Frac.new self
+  end
+
+  def over (den)
+    Frac.new self, den
+  end
+end
+
+struct Frac
+  include Comparable(Number)
+
+  getter num : Int64
+  getter den : Int64
+
+  def initialize (num : Int, den : Int)
+    raise "denominator can't be 0" if den.zero?
+    if num.zero?
+      @num, @den = 0_i64, 1_i64
+    else
+      sign = num.sign * den.sign
+      num, den = num.to_i64.abs, den.to_i64.abs
+      gcd = num.gcd(den)
+      @num = (num // gcd) * sign
+      @den = (den // gcd)
+    end
+  end
+
+  def initialize (num : Int)
+    initialize(num, 1)
+  end
+
+  def to_i
+    @num // @den
+  end
+
+  def to_f
+    @num / @den
+  end
+
+  def whole?
+    @den == 1
+  end
+
+  def to_frac
+    self
+  end
+
+  def inv
+    self.class.new @den, @num
+  end
+
+  def sign
+    @num.sign
+  end
+
+  def -
+    self.class.new -@num, @den
+  end
+
+  def abs
+    self.class.new @num.abs, @den
+  end
+
+  def + (other)
+    other = other.to_frac
+    lcm = @den.lcm(other.den)
+    self.class.new(@num * lcm // @den + other.num * lcm // other.den, lcm)
+  end
+
+  def - (other)
+    self + -other
+  end
+
+  def * (other)
+    other = other.to_frac
+    self.class.new @num * other.num, @den * other.den
+  end
+
+  def / (other)
+    self * other.to_frac.inv
+  end
+
+  def // (other)
+    other = other.to_frac
+    self.class.new((@num * other.den) // (@den * other.num))
+  end
+
+  def % (other)
+    other = other.to_frac
+    self.class.new((@num * other.den) % (@den * other.num), @den * other.den)
+  end
+
+  def <=> (other)
+    self.to_f <=> other.to_f
+  end
+end
+
+(2_i64 .. 2_i64**19).each do |candidate|
+  sum = 1.over candidate
+  (2_i64 .. Math.isqrt(candidate)).each do |factor|
+    if candidate % factor == 0
+      sum += 1.over(factor) + 1.over(candidate // factor)
+    end
+  end
+  if sum.whole?
+    puts "Sum of recipr. factors of %6d = %s exactly%s" % { candidate, sum.num, sum == 1 ? " perfect!" : "" }
+  end
+end

Task/Arithmetic-Rational/FutureBasic/arithmetic-rational.basic

@@ -0,0 +1,315 @@
+//
+// 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
+
+//

Task/Arithmetic-Rational/Nim/arithmetic-rational.nim

@@ -88,7 +88,7 @@ proc abs*(x: Rational): Rational =
   result.num = abs x.num
   result.den = abs x.den
 
-for candidate in 2'i64 .. <((2'i64)^19):
+for candidate in 2'i64 ..< ((2'i64)^19):
   var sum: Rational = (1'i64, candidate)
   for factor in 2'i64 .. pow(candidate.float, 0.5).int64:
     if candidate mod factor == 0:

Task/Arithmetic-Rational/REXX/arithmetic-rational.rexx

@@ -1,31 +1,27 @@
--- 24 Aug 2025
+-- 21 Feb 2026
 include Setting
 
 say 'RATIONAL ARITHMETIC'
 say version
 say
-a = '1 2'; b = '-3 4'; c = '5 -6'; d = '-7 -8'; e = 3; f = 1.666666666
+a='1 2'; b='-3 4'; c='5 -6'; d='-7 -8'; e=3; f=1.666666666
 say 'VALUES'
-say 'a =' Lst2FormQ(a)
-say 'b =' Lst2FormQ(b)
-say 'c =' Lst2FormQ(c)
-say 'd =' Lst2FormQ(d)
+say 'a =' Rat2form(a)
+say 'b =' Rat2form(b)
+say 'c =' Rat2form(c)
+say 'd =' Rat2form(d)
 say 'e =' e
 say 'f =' f
 say
 say 'BASICS'
-say 'a+b     =' Lst2FormQ(AddQ(a,b))
-say 'a+b+c+d =' Lst2FormQ(AddQ(a,b,c,d))
-say 'a-b     =' Lst2FormQ(SubQ(a,b))
-say 'a-b-c-d =' Lst2FormQ(SubQ(a,b,c,d))
-say 'a*b     =' Lst2FormQ(MulQ(a,b))
-say 'a*b*c*d =' Lst2FormQ(MulQ(a,b,c,d))
-say 'a/b     =' Lst2FormQ(DivQ(a,b))
-say 'a/b/c/d =' Lst2FormQ(DivQ(a,b,c,d))
-say '-a      =' Lst2FormQ(NegQ(a))
-say '1/a     =' Lst2FormQ(InvQ(a))
+say 'a+b =' Rat2form(AddQ(a,b))
+say 'a-b =' Rat2form(SubQ(a,b))
+say 'a*b =' Rat2form(MulQ(a,b))
+say 'a/b =' Rat2form(DivQ(a,b))
+say '-a  =' Rat2form(NegQ(a))
+say '1/a =' Rat2form(InvQ(a))
 say
-say 'Compare'
+say 'COMPARE'
 say 'a<b  =' LtQ(a,b)
 say 'a<=b =' LeQ(a,b)
 say 'a=b  =' EqQ(a,b)
@@ -34,30 +30,29 @@ say 'a>b  =' GtQ(a,b)
 say 'a<>b =' NeQ(a,b)
 say
 say 'BONUS'
-say 'Abs(c)      =' Lst2FormQ(AbsQ(c))
+say 'Abs(c)      =' Rat2form(AbsQ(c))
 say 'Float(b)    =' FloatQ(b)
-say 'Neg(d)      =' Lst2FormQ(NegQ(d))
-say 'Power(a,e)  =' Lst2FormQ(PowQ(a,e))
-say 'Rational(f) =' Lst2FormQ(RatQ(f))
+say 'Neg(d)      =' Rat2form(NegQ(d))
+say 'Power(a,e)  =' Rat2form(PowQ(a,e))
+say 'Rational(f) =' Rat2form(RatQ(f))
 say
 say 'FORMULA'
-say 'a^2-2ab+3c-4ad^4+5 = ',
-Lst2FormQ(AddQ(PowQ(a,2),MulQ(-2,a,b),MulQ(3,c),MulQ(-4,a,PowQ(d,4)),5))
+g=SquareQ(a); h=MulQ(-2,MulQ(a,b)); i=MulQ(3,c); j=MulQ(-4,MulQ(a,PowQ(d,4))); k=5
+say 'a^2-2ab+3c-4ad^4+5 =' Rat2form(AddQ(g,AddQ(h,AddQ(i,AddQ(j,k)))))
 say
-say 'Perfect numbers'
-call Time('r')
+say 'PERFECT NUMBERS'
 numeric digits 20
-do c = 6 to 2**19
-   s = 1 c; m = Isqrt(c)
-   do f = 2 to m
-      if c//f = 0 then do
-         s = AddQ(s,1 f,1 c/f)
-      end
-   end
+do c=6 to 2**19
+   s=1 c; m=Isqrt(c)
+   do f=2 to m
+      if c//f=0 then
+         s=AddQ(s,AddQ(1 f,f c))
+   end f
    if EqQ(s,1) then
       say c 'is a perfect number'
 end
-say Time('e')/1's'
+call Timer
 exit
 
+-- All procedures ending with 'Q'; Rat2form; Isqrt; Timer
 include Math