Rosetta Code

User:Xkrouhn: Difference between revisions

User page Discussion

User:Xkrouhn (view source)

Revision as of 15:23, 24 June 2011

438 bytes removed ,  12 years ago
m
Rm header, don't want to count flase code examples (this one is duplicated on the task page)
(Convert a decimal to fraction number)
 
m (Rm header, don't want to count flase code examples (this one is duplicated on the task page))
 
(6 intermediate revisions by 2 users not shown)
Line 1:
{{clarified-review}}{{task}}
Program to convert a decimal to fraction number.
 
Line 8 ⟶ 7:
'Examples of types decimal numbers:
 
67 / 74 = 0.9054054 >>> Mixed decimal number .
42 / 81 = 0.518518 >>> Pure decimal number
342 /4 81 = 0.75 518518 >>> ExactPure decimal number.
 
3/4 = 0.75 >>> Exact decimal number.
 
;Task Description
# Write a function/routine/method/... thatto will check whetherconvert a given positivedecimal integernumber isto self-describingfraction.
# As an optional stretch goal - generate and display the set of self-describing numbers.
 
 
=={{header|[[BASIC}}]]==
<lang qbasic>
'Programprogram to transform a decimal number to a fraction
'LRCVS 11.06.11
 
Line 25:
declare sub puro (a$, b$())
declare sub mixto (a$, b$())
declare subfunction multiplofactor (a$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
Line 36:
cls
input "Decimal number = ";a$
a2$ = a$
print
if instr(a$,".") = 0 then print "This isIt's not a decimal number " : goto 100
cls
l = len(a$)
Line 87 ⟶ 88:
next r
 
print "Decimaldecimal number = ";a$
print
 
'if b$(1) <> "" then print "repeticion = ";b$(1)
'print
ll = len(a$)
pp = instr(a$,".")
Line 96:
ps = instr(d$,b$(1))
if ps = 0 then
print "Exact decimalDecimal number exact"
print
call exacto (a$)
end if
if ps = 1 then
print "Pure decimalDecimal number pure"
print
call puro (a$, b$())
Line 107:
 
if ps > 1 then
print "Mixed decimalDecimal number mix"
print
call mixto (a$, b$())
Line 117:
end
 
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
sub exacto (a$)
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
Line 123 ⟶ 124:
c = instr(a$,".")
d = b - c
z$ = "0"
g = int(val(a$))
h$ = right$(a$, b - c)
Line 130:
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 = 1
if j > k then may = j else may = k
for n = 1 to may
r = (j mod n)
s = (k mod n)
if r = 0 and s = 0 then l = n
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, r, s, u, v, w, f, lr,x5
dim as string z, h, g1, x, a3
 
'decimal puro
z$ = b$(1)
x5 = int(val(a$))
lr = len (z$)
b2 = len (a$)
Line 156 ⟶ 154:
g = int (val(a$))
b2 = len(z$) + 1 + len(str$(g))
aa3$ = str$(g) + "." + z$
h$ = right$(aa3$, b2 - c)
 
may = 0
x$ = ""
for n = 1 to lr
Line 167 ⟶ 165:
j = val(x$)
k = val(h$)
 
l = 1
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
if j > k then may = j else may = k
for n = 1 to may
r = (j mod n)
s = (k mod n)
if r = 0 and s = 0 then l = n
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, may, j, k, l, r, s, u, v, w, f, lr, lz, ly, x5
dim as string z, h, g4, g7, x, y
 
Line 197 ⟶ 195:
b3 = (val(y$)*(9*(10^ly))) + ((1*(10^ly))* (val(z$)))
c = (9*(10^ly))*(1*(10^ly))
 
may = 0
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)
if j > k then may = j else may = k
u = k/l
for n = 1 to may
rv = (j mod n)/l
s = (k mod n)
if r = 0 and s = 0 then l = n
next n
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
f = len(a$)
print "Option >>> "
j = 0
call exacto (a$)
if x5 <> 0 then g7$ = str$(((x5*v)+u)/u) else g7$ = str$(v/u)
if mid$(a$,1,f) <> mid$(g7$,1,f) then print ">>> error !!!" :j = 1
 
if j = 1 then call multiplo (a$)
 
end sub
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 
function factor (j as integer, k as integer) as integer
sub multiplo (a$)
dim as integer jmay, bn, cs, gr, hl5, kj5, n, u, v k5
may = 0
dim as string e,f
l5 = 1
cls
j5 = j
print "Numero decimal exacto"
k5 = k
print
for n = 9 to 1 step - 1
j = 0
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
b = len(a$)
c = instr(a$,".")
d = b - c
e$ = str$(int(val(a$)))
f$ = mid$(a$,c + 1 , d)
g = val(e$+f$)
h = 1*(10^d)
may = 0 'limite
j = g
k = h
if j > k then may = j else may = k
for n = 9 to 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
forif nj5 > k5 then may = 1j5 toelse jmay *= kk5
for n = may to 1 step - 1
if j mod n = 0 and k mod n = 0 then l = n :exit for
r = (j5 mod n)
s = (k5 mod n)
if r = 0 and s = 0 then l5 = n :exit for
next n
factor = l5
u = k/l 'numerador
end function
v = j/l 'denominador
print v;"/";u ;" = "; v / u
end sub
 
end</lang>
Anonymous user
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/187973...187980"