Chapter 10. Complete Examples

Table of Contents
10.1. frac.sci
10.2. benchmark.sci
10.3. listdiff.sci
10.4. whatis.sci
10.5. Auto-Determination of Precedence and Associativity
10.6. cat.sci
10.7. quadpack.sci

Welcome to our attic! Following the style of the bag-of-tricks, the examples gathered here are an unsorted collection of hacks that has piled up over the years. A few functions are used or discussed in the earlier section, but were truncated to emphasized the important parts. Here you only find complete versions. All programs in this Appendix are available in a sigle tar or zip file; see Section 3 for details.

These example programs are free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License at the end of this document for more details.

You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.

10.1. frac.sci

frac.sci implements a rather complete class of fractions which are based on floating point numbers.


// name:        frac.sci  --  a class of fractions implemented
//                            with operator overloading


//
// The names 'gcd', 'lcm', and 'qr' are already occupied
// by Scilab, so we had to invent new ones.  ;-)
//


function w = gcd_int(u, v)
// gcd of _positive_ u and v!  See e.g.: Knuth, vol2, p337
while v ~= 0
    r = modulo(u, v)
    u = v
    v = r
end
w = u


function [p_red, q_red] = reduce_int(p, q)
// reduce fraction p/q and return reduced fraction p_red/q_red as vector
if q == 0, error('not a fraction'), end
r = gcd_int(abs(p), abs(q))
if q < 0 then
    r = -r // force positive denominator
end
[p_red, q_red] = (p/r, q/r)


function assert_int(p)
if type(p) ~= 1 | p ~= int(p) | imag(p) ~= 0 then
    error('assertion failed: non-integral or non-real p = ' + string(p))
end

    
function f = frac(p, q, reduce)
// constructor for fractions
//
// p is the numerator, q is the denominator.  If q is
// omitted, 1 is assumed.  The boolean reduce controls whether
// p/q will be reduced.  If reduce is omitted or %t the p/q
// will be reduced.
//
// frac(int, int, bool = %t):    /* constructor */
// frac(2, 6)      -->  1/3
// frac(2)         -->  2/1 which is displayed as 2
// frac(2, 6, %t)  -->  1/3
// frac(2, 6, %f)  -->  2/6
//
// frac(frac, frac, bool = %t):    /* copy constructor */
// f = frac(1, 3);
// frac(f)         -->  1/3
// frac(f, f)      -->  1
// frac(1, f)      -->  3

select type(p)
case 1 then // constant
    if size(p, '*') ~= 1 then
        error('argument p is non-scalar')
    end
    p0 = p
    q0 = 1
case 16 then // tlist
    // copy constructor behavior
    p0 = p('num')
    q0 = p('denom')
else
    error('argument p has wrong type')
end

if exists('q', 'local') then // q is an optional argument
    select type(q)
    case 1 then // constant
        if size(q, '*') ~= 1 then
            error('argument q is non-scalar')
        end
        q0 = q0 * q
    case 16 then // tlist
        // copy constructor behavior
        p0 = p0 * q('denom')
        q0 = q0 * q('num')
    else
        error('argument q has wrong type')
    end
end

// ensure that arguments match
assert_int(p0)
assert_int(q0)

if exists('reduce', 'local') then // (isdef('reduce') & reduce == %t) does not work, for
                        // Scilab performs a complete boolean evaluation
    if reduce == %t then
        [p_red, q_red] = reduce_int(p0, q0)
    else
        p_red = p0
        q_red = q0
    end
else
    [p_red, q_red] = reduce_int(p0, q0)
end
f = tlist(['frac'; 'num'; 'denom'], p_red, q_red)


function s = %frac_p(f)
// display function for fractions
s = string(f)
disp(s)


//
// comparison
//

function b = %frac_o_frac(f1, f2)
b = f1('num') == f2('num')  &  f1('denom') == f2('denom')


function b = %frac_n_frac(f1, f2)
b = ~%frac_o_frac(f1, f2)


function b = %frac_o_s(f, s)
assert_int(s)
b = %frac_o_frac(f, frac(s))


function b = %s_o_frac(s, f)
assert_int(s)
b = %frac_o_s(f, s)


function b = %frac_n_s(f, s)
assert_int(s)
b = ~%frac_n_frac(f, frac(s))


function b = %s_n_frac(s, f)
assert_int(s)
b = %frac_n_s(f, s)


function b = %frac_1_frac(f1, f2)
b = f1('num')*f2('denom') < f1('denom')*f2('num')


function b = %frac_2_frac(f1, f2)
b = f1('num')*f2('denom') > f1('denom')*f2('num')


function b = %frac_3_frac(f1, f2)
// <=
b = %frac_1_frac(f1, f2) | %frac_o_frac(f1, f2)


function b = %frac_4_frac(f1, f2)
// >=
b = %frac_2_frac(f1, f2) | %frac_o_frac(f1, f2)


function b = %frac_1_s(f, s)
assert_int(s)
b = %frac_1_frac(f, frac(s))


function b = %s_1_frac(s, f)
assert_int(s)
b = %frac_1_frac(frac(s), f)


function b = %frac_2_s(f, s)
assert_int(s)
b = %frac_2_frac(f, frac(s))


function b = %s_2_frac(s, f)
assert_int(s)
b = %frac_2_frac(frac(s), f)


function b = %frac_3_s(f, s)
assert_int(s)
b = %frac_3_frac(f, frac(s))


function b = %s_3_frac(s, f)
assert_int(s)
b = %frac_3_frac(frac(s), f)


function b = %frac_4_s(f, s)
assert_int(s)
b = %frac_4_frac(f, frac(s))


function b = %s_4_frac(s, f)
assert_int(s)
b = %frac_4_frac(frac(s), f)


//
// addition/subtraction
//

function r = %frac_a_frac(f1, f2)
d1 = gcd_int(f1('denom'), f2('denom'))
if d1 == 1 then
    r = frac(f1('num')*f2('denom') + f1('denom')*f2('num'), ..
                 f1('denom')*f2('denom'))
else
    t = f1('num')*(f2('denom') / d1) + f2('num')*(f1('denom') / d1)
    d2 = gcd_int(t, d1)
    r = frac(t/d2, (f1('denom') / d1)*(f2('denom') / d2))
end


function r = %frac_s_frac(f1, f2)
d1 = gcd_int(f1('denom'), f2('denom'))
if d1 == 1 then
    r = frac(f1('num')*f2('denom') - f1('denom')*f2('num'), ..
                 f1('denom')*f2('denom'))
else
    t = f1('num')*(f2('denom') / d1) - f2('num')*(f1('denom') / d1)
    d2 = gcd_int(t, d1)
    r = frac(t/d2, (f1('denom') / d1)*(f2('denom') / d2))
end


function r = %frac_s(f)
r = frac(-f('num'), f('denom'), %f) // do not reduce here


function r = %frac_a_s(f, s)
assert_int(s)
r = f + frac(s)


function r = %s_a_frac(s, f)
assert_int(s)
r = %frac_a_s(f, s)


function r = %frac_s_s(f, s)
assert_int(s)
r = f - frac(s)


function r = %s_s_frac(s, f)
assert_int(s)
r = frac(s) - f


//
// multiplication, division, power
//

function r = %frac_m_frac(f1, f2)
r = frac(f1('num')*f2('num'), f1('denom')*f2('denom'))


function r = %frac_r_frac(f1, f2)
r = frac(f1('num')*f2('denom'), f1('denom')*f2('num'))


function r = %frac_m_s(f, s)
assert_int(s)
r = frac(f('num')*s, f('denom'))


function r = %s_m_frac(s, f)
assert_int(s)
r = %frac_m_s(f, s)


function r = %frac_r_s(f, s)
assert_int(s)
r = frac(f('num'), f('denom')*s)


function r = %s_r_frac(s, f)
assert_int(s)
r = frac(f('denom')*s, f('num'))


function r = %frac_p_s(f, s)
assert_int(s)
r = frac(f('num')^s, f('denom')^s)


function r = %frac_abs(f)
r = frac(abs(f('num')), f('denom'), %f)


//
// conversion
//

function fl = frac2float(f)
// convert a fraction to a floating point number
fl = f('num') / f('denom')


function s = %frac_string(f)
// string( frac(...) )
if f('denom') == 1 then
    s = sprintf('%.0f', f('num'))
else
    s = sprintf('%.0f/%.0f', f('num'), f('denom'))
end


//
// continued fraction functions (and their helper functions)
// See: Knuth, vol2, p356-359
//

function f = cfe2frac(cfe)
// *private function*
// convert the continued fraction expansion CFE to a floating point number F
// (recursive implementation)
select length(cfe)
case 0 then
    f = frac(0, 1, %f)
case 1 then
    f = frac(1, cfe(1), %f)
else
    q = cfe2frac( cfe(2:$) )
    f = 1 / (frac(cfe(1), 1, %f) + q)
end


function f = cfe2frac_it(cfe)
// *private function*
// convert the continued fraction expansion CFE to a floating point number F
// (iterative implementation)
if cfe == [] then
    f = frac(0, 1, %f)
else
    f = frac(1, cfe($), %f)
    for x = cfe($-1 : -1 : 1)
        f = 1 / (f + x)
    end
end


function cfe = contfrac(fl, eps)
// *private function*
// continued fraction expansion of floating point number FL with a
// maximum error of EPS.
// CAUTION: contfrac() only accepts numbers in the range 0 <= fl < 1!
if fl < 0 | fl >= 1, error('fl out of range'), end

if ~isdef('eps'), eps = sqrt(%eps), end

guard = 100 // maximum length of expansion
i = 0

cfe = []
if fl == 0, return, end
x = fl
while abs(1 - frac2float(cfe2frac(cfe))/fl) > eps  &  i < guard
    a = round(1 / x)
    cfe = [cfe a]
    x = 1/x - a
    i = i + 1
end
if i == guard then
    warning('could not achieve precision after ' ..
            + string(guard) + ' iterations')
end


function f = float2frac(fl, eps)
// convert the floating point number FL to the fraction F
// with a maximum relative error of EPS
intpart = floor(fl)           // floor([3.33 -3.33]) -> [3 -4]
f = intpart + cfe2frac( contfrac(fl - intpart, eps) )

testfrac.sci provides a simple tast-frame for the class of fractions describes above.


// name:        testfrac.sci  --  test fractions class


getf('frac.sci');


f = frac(2, 3);
g = frac(1, 3);
h = frac(-1, 3);
i = frac(5, 3);


//
// each of the following tests should give %t
//

frac(0) == 0
frac(1) == 1
frac(-1) == -1
frac(0, 1) == 0
frac(1, 1) == 1
frac(2, 2) == 1

f + g == 1
g + h == 0
f - (g - h) == 0

1 + f == i
f + 1 == i
1 - f == g
f - 1 == h

-g == h

3 * f == 2
f * 3 == 2

f / g == 2
f / 2 == g
2 / f == 3

9 * g^2 - 1 == 0

g < f
f > g
g <= f
f >= g
f < 1
f > 0
f <= 1
g >= 0

abs(g) == g
abs(h) == g


//
// continued fraction expansion
//

frac(8, 29) == cfe2frac([3 1 1 1 2]) // recursive implementation
frac(8, 29) == cfe2frac_it([3 1 1 1 2]) // iterative implementation


n = 10

// 0 <= x < 1 in this test
x = 1/%pi;
timer();
for d = 1:n
    eps = 10^(-d);
    c = contfrac(x, eps);
    f = cfe2frac(c);
    fl = frac2float(f);
    delta = abs( x - fl );
    if delta <= eps, passed = 'T'; else passed = 'F'; end;
    printf('%10.g    %20.16g    %c', eps, delta, passed);
end
printf('time: %f', timer());


// x should be larger than 1 or less than 0 in this test
x = %pi;
timer();
for d = 1:n
    eps = 10^(-d);
    fl = frac2float( float2frac(x, eps) );
    delta = abs( x - fl );
    if delta <= eps, passed = 'T'; else passed = 'F'; end;
    printf('%10.g    %20.16g    %c', eps, delta, passed);
end
printf('time: %f', timer());


x = -(1 + sqrt(5)) / 2;
timer();
for d = 1:n
    eps = 10^(-d);
    fl = frac2float( float2frac(x, eps) );
    delta = abs( x - fl );
    if delta <= eps, passed = 'T'; else passed = 'F'; end;
    printf('%10.g    %20.16g    %c', eps, delta, passed);
end
printf('time: %f', timer());


//
// Some power series
//

// geometric series
z = frac(1, 3);
for n = 1:20
    s = frac(1);
    q = z;
    for i = 1 : n-1
        s = s + q;
        q = q * z;
    end
    rhs = (1 - z^n) / (1 - z);
    if s == rhs, passed = 'T'; else passed = 'F'; end;
    disp(string(n) + ': ' + string(rhs) + '    ' + passed);
end;

// exponential sums
limit = 1e-8

s = frac(1);
q = frac(1, 2);
while frac2float(abs(s - 2)) > limit
    s = s + q;
    q = q / 2;
end;
if frac2float(abs(s - 2)) <= limit, disp(%t); else disp(%f); end;

s = frac(1);
q = frac(1, 2);
sgn = -1;
while frac2float(abs(s - frac(2, 3))) > limit
    s = s + q * sgn;
    sgn = -sgn;
    q = q / 2;
end;
if frac2float(abs(s - frac(2, 3))), disp(%t); else disp(%f); end;