User:Xkrouhn

From Rosetta Code

Program to convert a decimal to fraction number.

For transform a decimal to a fraction, previously we have to know what type is the decimal number, here are some examples

'Examples of types decimal numbers:

67 / 74 = 0.9054054 >>> Mixed decimal number.

42 / 81 = 0.518518 >>> Pure decimal number.

3/4 = 0.75 >>> Exact decimal number.

Task Description
  1. Write a function to convert a decimal number to fraction.


BASIC[edit]

 
'program to transform a decimal number to fraction
'LRCVS 11.06.11
 
DECLARE SUB exacto (a$)
DECLARE SUB puro (a$, b$())
DECLARE SUB mixto (a$, b$())
DECLARE FUNCTION factor (j , k ) AS INTEGER
 
DIM AS INTEGER l, r, s, t, k, w1, i, m, x, ll, pp, ps, u, v, j
 
DIM AS STRING a, c, d, a2
 
DIM y () AS STRING
DIM w2 () AS STRING
 
CLS
INPUT "Decimal number = ";a$
a2$ = a$
PRINT
IF INSTR(a$,".") = 0 THEN PRINT "It's not a decimal number " : GOTO 100
CLS
l = LEN(a$)
 
FOR r = 1 TO l
FOR s = 1 TO l
IF s + r = l + 2 THEN EXIT FOR
k = k + 1
NEXT s
NEXT r
 
w1 = k
REDIM y$(w1)
REDIM b$(w1)
 
k = 0
FOR r = 1 TO l
FOR s = 1 TO l
c$ = MID$(a$,r,s)
IF s + r = l + 2 THEN EXIT FOR
IF LEN(c$) <= INT(l/2) THEN k = k + 1 : y$(k) = c$
NEXT s
NEXT r
t = 0
 
FOR r = 1 TO k
i = 0
f = 0
x = 0
m = 0
IF i = 0 THEN i = INSTR(a$,y$(r)):x = 1
FOR s = 1 TO LEN(a$)
IF x = 1 THEN f = INSTR(s,a$,y$(r))
IF x = 1 AND f > m THEN m = f
NEXT s
 
h = 0
k = 0
FOR n = i TO m STEP LEN(y$(r))
IF h = 0 AND MID$(a$,n,LEN(y$(r))) = y$(r) THEN k = k + 1 ELSE h = 1
NEXT n
IF k > 1 THEN t = t + 1 :b$(t) = y$(r)
NEXT r
 
FOR r = 1 TO w1
FOR s = r + 1 TO w1
IF b$(r) = b$(s) THEN b$(s) = ""
NEXT s
NEXT r
 
PRINT "decimal number = ";a$
PRINT
 
ll = LEN(a$)
pp = INSTR(a$,".")
d$ = MID$(a$,pp+1,ll)
ps = INSTR(d$,b$(1))
IF ps = 0 THEN
PRINT "Decimal number exact"
PRINT
CALL exacto (a$)
END IF
IF ps = 1 THEN
PRINT "Decimal number pure"
PRINT
CALL puro (a$, b$())
END IF
 
IF ps > 1 THEN
PRINT "Decimal number mix"
PRINT
CALL mixto (a$, b$())
END IF
100:
PRINT
PRINT "End"
SLEEP
END
 
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
SUB exacto (a AS STRING)
DIM AS INTEGER b, c, d, g, may, j, k, l, r, s, u, v, w, f
DIM AS STRING z, h, g1
b = LEN(a$)
c = INSTR(a$,".")
d = b - c
g = INT(VAL(a$))
h$ = RIGHT$(a$, b - c)
 
may = 0
j = 10^d
k = VAL(h$)
FOR n = 9 TO 1 STEP - 1
IF j MOD (1*(10^n)) = 0 AND k MOD (1*(10^n)) = 0 THEN j = j/(1*(10^n)) : k = k/(1*(10^n)) :EXIT FOR
NEXT n
l = factor (j,k)
u = k/l
v = j/l
w = (g * v) + u
PRINT
PRINT w;"/";v ;" = " ;w/v
 
END SUB
 
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
SUB puro (a AS STRING, b() AS STRING)
DIM AS INTEGER b2, c, d, g, may, j, k, l, u, v, w, f, lr,x5
DIM AS STRING z, h, g1, x, a3
 
z$ = b$(1)
x5 = INT(VAL(a$))
lr = LEN (z$)
b2 = LEN (a$)
c = INSTR (a$,".")
g = INT (VAL(a$))
b2 = LEN(z$) + 1 + LEN(STR$(g))
a3$ = STR$(g) + "." + z$
h$ = RIGHT$(a3$, b2 - c)
 
may = 0
x$ = ""
FOR n = 1 TO lr
x$ = x$ + "9"
NEXT n
 
j = VAL(x$)
k = VAL(h$)
 
FOR n = 9 TO 1 STEP - 1
IF j MOD (1*(10^n)) = 0 AND k MOD (1*(10^n)) = 0 THEN j = j/(1*(10^n)) : k = k/(1*(10^n)) :EXIT FOR
NEXT n
l = factor (j,k)
u = k/l
v = j/l
w = (g * v) + u
PRINT w;"/";v ;" = ";w/v
PRINT
PRINT "Option >>> "
CALL exacto (a$)
 
END SUB
 
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
SUB mixto (a AS STRING, b() AS STRING)
 
DIM AS INTEGER b3, c, d, g, j, k, l, u, v, w, f, lr, lz, ly, x5
DIM AS STRING z, h, g4, g7, x, y
 
z$ = b$(1)
x5 = INT(VAL(a$))
w = INSTR(a$, z$)
v = INSTR(a$,".")
y$ = MID$(a$,v+1,w-v-1)
lz = LEN(z$)
ly = LEN(y$)
b3 = (VAL(y$)*(9*(10^ly))) + ((1*(10^ly))* (VAL(z$)))
c = (9*(10^ly))*(1*(10^ly))
j = b3
k = c
FOR n = 9 TO 1 STEP - 1
IF j MOD (1*(10^n)) = 0 AND k MOD (1*(10^n)) = 0 THEN j = j/(1*(10^n)) : k = k/(1*(10^n)): EXIT FOR
NEXT n
l = factor (b3,c)
u = k/l
v = j/l
IF x5 <> 0 THEN PRINT (x5*v)+ u;"/";u ;" = ";((x5*v)+ u)/u ELSE PRINT v;"/";u;" = "; v/u
PRINT
PRINT "Option >>> "
CALL exacto (a$)
END SUB
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FUNCTION factor (j AS INTEGER, k AS INTEGER) AS INTEGER
DIM AS INTEGER may, n, s, r, l5, j5, k5
may = 0
l5 = 1
j5 = j
k5 = k
FOR n = 9 TO 1 STEP - 1
IF j5 MOD (1*(10^n)) = 0 AND k5 MOD (1*(10^n)) = 0 THEN j5 = j5/(1*(10^n)) : k5 = k5/(1*(10^n)): EXIT FOR
NEXT n
IF j5 > k5 THEN may = j5 ELSE may = k5
FOR n = may TO 1 STEP - 1
r = (j5 MOD n)
s = (k5 MOD n)
IF r = 0 AND s = 0 THEN l5 = n :EXIT FOR
NEXT n
factor = l5
END FUNCTION
END