106 lines
3.4 KiB
Text
106 lines
3.4 KiB
Text
Rebol [
|
|
title: "Rosetta code: Fraction reduction"
|
|
file: %Fraction_reduction.r3
|
|
url: https://rosettacode.org/wiki/Fraction_reduction
|
|
needs: 3.21.5
|
|
]
|
|
|
|
unless native? :idivide [
|
|
;; backward compatibility
|
|
idivide: func[a b][to integer! (a / b)]
|
|
]
|
|
|
|
fraction-reduction: function/with [
|
|
lo [integer!] "lower bound of range"
|
|
hi [integer!] "upper bound of range"
|
|
/verbose
|
|
][
|
|
len: length? form hi ;; number of digits
|
|
omitted: array/initial 9 0 ;; ommitted digits counters
|
|
|
|
n-digits: clear [] ;; digit buffer for numerator
|
|
d-digits: clear [] ;; digit buffer for denominator
|
|
|
|
count: 0
|
|
for n lo hi 1 [
|
|
unless get-digits n len n-digits [continue] ;; skip numbers that don't qualify
|
|
for d n + 1 hi + 1 1 [
|
|
;; extract and validate denominator digits
|
|
unless get-digits d len d-digits [continue] ;; skip invalid denominators
|
|
|
|
repeat ni len [
|
|
all [
|
|
nv: n-digits/:ni ;; get numerator digit
|
|
di: index? find d-digits nv ;; find matching digit in denominator
|
|
rn: remove-digit n-digits len ni ;; numerator with shared digit removed
|
|
rd: remove-digit d-digits len di ;; denominator with shared digit removed
|
|
n * rd == (rn * d) ;; cross-multiply to check n/d = rn/rd
|
|
++ count ;; increment match counter
|
|
omitted/:nv: omitted/:nv + 1 ;; track which digit was cancelled
|
|
verbose ;; check if output is needed
|
|
prin [CR n "/" d "=" rn "/" rd "by omitting" nv "'s"]
|
|
count <= 12 ;; only print first 12 matches
|
|
prin LF ;; newline after match
|
|
]
|
|
]
|
|
]
|
|
]
|
|
if verbose [print "^M^[[K"] ;; clear last line
|
|
;; return output as a map
|
|
compose/only #[
|
|
digit: (len)
|
|
count: (count)
|
|
omitted: (omitted)
|
|
]
|
|
][
|
|
|
|
get-digits: function/with [
|
|
;; extract digits of n, reject if invalid (zero digit, repeated digit)
|
|
num len digits
|
|
][
|
|
if invalid/:num [return false]
|
|
n: num
|
|
append/dup clear digits 0 len ;; reset digit buffer
|
|
while [n > 0][
|
|
r: n % 10
|
|
if find digits r [
|
|
invalid/:num: true
|
|
return false
|
|
]
|
|
digits/:len: r
|
|
-- len
|
|
n: idivide n 10
|
|
]
|
|
true
|
|
][
|
|
;; cache invalid numbers
|
|
invalid: make bitset! []
|
|
]
|
|
remove-digit: function [digits len idx][
|
|
sum: 0
|
|
pow: pick [1 10 100 1000 10000] len - 1
|
|
repeat i len [
|
|
if i = idx [continue]
|
|
sum: sum + (digits/:i * pow)
|
|
pow: idivide pow 10
|
|
]
|
|
sum
|
|
]
|
|
]
|
|
ranges: [
|
|
12 97
|
|
123 986
|
|
1234 9875
|
|
;12345 98764
|
|
]
|
|
foreach [lo hi] ranges [
|
|
print [as-yellow "Using range:" lo "to" hi]
|
|
res: fraction-reduction/verbose lo hi
|
|
print rejoin ["There are " res/count " " res/digit "-digit fractions of which:"]
|
|
repeat i 9 [
|
|
unless zero? v: res/omitted/:i [
|
|
print rejoin [pad v -6 " have " i "'s omitted"]
|
|
]
|
|
]
|
|
print ""
|
|
]
|