#
#--> sprint(x);  or  sprint(x1,x2,...,xn);
#
# Input: object(s) to be printed x
# Ouput: short form for x is printed as a side effect, NULL is returned
#
# Intended to display the "structure" of big expressions, including matrices.
# Typical output:
#
#	A <<+120>> - A B <<+420>>
#
# The notation <<+120>> means that what has not been printed is a sum
# of 120 terms, and is too big to be printed in full.
#
# When a sub-expression of x is "too big" then a "descriptor"
# for the object is printed instead.  The descriptor will indicate
# the type of the object, and its size.
# The desciptors are
#
# 	type		descriptor	meaning
#
#	string		string[n]	n characters
#	integer		integer[n]	n digits
#	fraction	fraction[n,m]	n digits in numerator, d in denominator
#	float		float[m,e]	m digits in mantissa
#	`+`		<<+n>>		n terms in a sum	
#	`*`		<<*n>>		n factors in a product	
#	sequence	<<,n>>		sequence with n>1 terms
#	series		<<series[n]>>	series with n terms
#	list		<<list[n]>>	list of n elements
#	set		<<set[n]>>	set of n elements
#	vector		<<vector[n]>>	vector of n elements
#	matrix		<<matrix[m,n]>>	m by n matrix
#	function	<<foo[n]>>	function named foo with n arguments
#	function	<<function[n]>>	function with n arguments
#	array		<<array[n]>>	array with n entries
#	table		<<table[n]>>	table with n entries
#	procedure	<<procedure>>	procedure
#	operator	<<operator>>	operator
#
# The basic idea of the algorithm is to recursively descend the expression
# testing as we go whether it is too big, whether nops(x) > n .
# As it recurses, it divides n by nops(x) .
# Thus the deeper it descends, the more likely it will produce a descriptor.
# Eventually n will be reduced to 0 which implies that at some level,
# only descriptors will be produced.
# However, objects of length less than 20 are always printed in full.
# Also, to the efficiency minded, the algorithm is O(n) .
#
# So, the parameter n can be used as follows.
# The smaller n, the smaller the output will be as more sub-expressions
# will be given descriptors.
# Conversely, the larger n, the larger the output,
# more of the expression will be printed.
# A little experimentation and you will see how it works.
# The parameter n is set by assigning _EnvSprint (default 100)
#
# Author: MBM Apr/90.
# Updated: MBM Nov/93
#

macro(	string='string', integer='integer', fraction='fraction', float='float',
	`+` = '`+`', `*` = '`*`', series='series', set='set', list='list',
	array='array', table='table', vector='vector', matrix='matrix',
	function='function', operator='operator', procedure='procedure'	);


macro(	N = 20, M = 100, T = _EnvSprint );
macro(	LENGTH = `sprint/length`,
	CAT = `sprint/cat`,
	PRINT = `sprint/sprint` );


sprint := proc()
    if assigned(_EnvSprint) then
	if not type(_EnvSprint,posint) then
            print(`_EnvSprint must be assigned a positive integer`);
	    _EnvSprint := M;
	fi;
    else _EnvSprint := M;
    fi;
    print( PRINT(args) );
end:


LENGTH := proc(x,n) local t,y,z;
    if type(x,{string,numeric}) then length(x)
    else
	t := nops(x);
	for y in x while t < n do
	    if nops([y]) = 1 then t := t + LENGTH(y,n-t); next fi;
	    for z in [y] while t < n do t := t + LENGTH(y,n-t) od
	od;
	t
    fi
end:

CAT := proc() subs( 'dummy'=cat(args), proc() local dummy; dummy end )() end:

PRINT := proc(x) local k,l,n;
	
    if nargs <> 1 then
	n := nargs;
	if n = 0 then NULL
        elif n < _EnvSprint or LENGTH([args],N) < N then
	    _EnvSprint := iquo(_EnvSprint,n);
	    seq( PRINT(k), k=[args] );
	else CAT(`<<,`,n,`>>`)
	fi;

    elif type(x,string) and not type(x,{array,table}) then
	l := length(x);
	if l < max(_EnvSprint,N) then x
	else string[l]
	fi

    elif type(x,integer) then
	l := length(x);
	if l < max(_EnvSprint,N) then x else integer[l] fi

    elif type(x,fraction) then
	if length(x) < max(_EnvSprint,N) then x
	else fraction[length(op(1,x)),length(op(2,x))]
	fi

    elif type(x,float) then
	if length(x) < max(_EnvSprint,N) then x
	else float[length(op(1,x)),op(2,x)]
	fi

    elif type(x,indexed) then
	n := nops(x);
	if n = 0 then x
	elif n < _EnvSprint or LENGTH(x,N) < N then
	    _EnvSprint := iquo(_EnvSprint,n);
	    op(0,x)[seq( PRINT(k), k=x )];
	else CAT(`<<indexed[`,n,`]>>`)
	fi

    elif type(x,`^`) then
	if op(2,x) = -1 then map(PRINT,x) else
	    _EnvSprint := iquo(_EnvSprint,2);
	    map(PRINT,x)
	fi;

    elif type(x,`*`) then
	n := nops(x);
	if op(1,x) = -1 then - PRINT( subsop(1=1,x) )
	elif 2*n < _EnvSprint or LENGTH(x,N) < N then
	    _EnvSprint := iquo(_EnvSprint,n);
	    map( PRINT, x )
	else CAT(`<<*`,n,`>>`)
	fi

    elif type(x,`+`) then
	n := nops(x);
	if 2*n < _EnvSprint or LENGTH(x,N) < N then
	    _EnvSprint := iquo(_EnvSprint,n);
	    map( PRINT, x )
	else CAT(`<<+`,n,`>>`)
	fi

    elif type(x,series) then
	n := nops(x);
	if n < _EnvSprint or LENGTH(x,N) < N then
	    _EnvSprint := iquo(_EnvSprint,n);
	    map( PRINT, x )
	elif type(op(0,x),string) and length(op(0,x)) < N
	then CAT(`<<series[`,op(0,x),`,`,n/2,`]>>`)
	else CAT(`<<series[`,n/2,`]>>`)
	fi

    elif type(x,function) then
	n := nops(x);
	if n = 0 then x
	elif n < _EnvSprint or LENGTH(x,N) < N then
	    _EnvSprint := iquo(_EnvSprint,n);
	    map( PRINT, x )
	elif type(op(0,x),string) and length(op(0,x)) < N
	then CAT(`<<`,op(0,x),`[`,n,`]>>`)
	else CAT(`<<function[`,n,`]>>`)
	fi

    elif type(x,{list,set}) then
	n := nops(x);
	if n = 0 then x
	elif n < _EnvSprint or LENGTH(x,N) < N then
	    _EnvSprint := iquo(_EnvSprint,n);
	    map( PRINT, x )
	elif type(x,list) then CAT(`<<list[`,n,`]>>`)
	else CAT(`<<set[`,n,`]>>`)
	fi

    elif type(x,vector) then
	l := linalg[vectdim](x);
	if l = 0 then x
	elif l < _EnvSprint then
	    _EnvSprint := iquo(_EnvSprint,l);
	    map( PRINT, x )
	else CAT(`<<vector[`,l,`]>>`)
	fi

    elif type(x,matrix) then
	k := linalg[rowdim](x);
	l := linalg[coldim](x);
	if k*l < 2*_EnvSprint then
	    _EnvSprint := iquo(_EnvSprint,k+l);
	    map( PRINT, x )
	else CAT(`<<matrix[`,k,`,`,l,`]>>`)
	fi

    elif type(x,{array,table}) then
	l := nops([indices(x)]);
	if l = 0 then x
	elif l < _EnvSprint then
	    _EnvSprint := iquo(_EnvSprint,l);
	    map( PRINT, x )
	elif type(x,array) then CAT(`<<array[`,l,`]>>`)
	else CAT(`<<table[`,l,`]>>`)
	fi

    elif type(x,procedure) then
	if length(x) < max(_EnvSprint,N) then x
	elif has([op(3,x)],operator) then CAT(`<<operator>>`)
	else CAT(`<<procedure>>`)
	fi

    else

	_EnvSprint := iquo(_EnvSprint,nops(x));
	map( PRINT, x );
    fi

end:

`help/text/sprint` := TEXT(
`FUNCTION: sprint - smart printing of a Maple expression`,`      `,
`CALLING SEQUENCES: sprint(e);`,`      `,`PARAMETERS: e - expression`,`      `,
`SYNOPSIS:   `,
`- The sprint function is for printing large expressions.  It will print the`,
`  ````top levels'' of a large expression so that the user can see the "struct\
ure"`,`  of an expression.  Best understood by looking at examples.`,
`- The global environment variable _EnvSprint can be assigned a positive`,
`  integer to control how much of the expression is displayed.  The larger`,
`  the value, the more of the expression will be displayed.`,
`- The history function can be used to make this facility automatic.`,
`  By doing readlib(history)(sprint); the sprint function will be used`,
`  to output the results in conjunction with the history mechanism.`,`      `,
`EXAMPLES:   `,`      `,
`> e := [convert(taylor(exp(x),x),confrac), solve(x^3+x^2+1,x)[1]]:`,
`> sprint(e);`,`   `,
`                   x        / 29           1/2\1/3        1`,
`         [1 + ----------, - |---- + 1/18 93   |    - ----------- - 1/3]`,
`                     x      \ 54              /              1/3`,
`              1 + ------                             9 <<+2>>`,
`                  <<+2>>`,`   `,`> _EnvSprint := 20;`,`> sprint(e);`,`   `,
`                            x            1/3`,
`                    [1 + ------, - <<+2>>    + <<*2>> - 1/3]`,
`                         <<+2>>`,`   `,`> _EnvSprint := 1000;`,`> sprint(e);`,
`   `,`                          x`,`         [1 + -------------------------,`,
`                            x`,`              1 + ---------------------`,
`                               x`,`                  - 2 + ---------------`,
`                                  x`,`                        - 3 + ---------`
,`                              2 + 1/5 x`,`   `,
`               / 29           1/2\1/3               1`,
`             - |---- + 1/18 93   |    - ------------------------ - 1/3]`,
`               \ 54              /        / 29           1/2\1/3`,
`                                        9 |---- + 1/18 93   |`,
`                                          \ 54              /`,`   `,
`> readlib(history)(sprint);`,`O1 := _EnvSprint := 100;`,`   `,
`                                      100`,`   `,
`O2 := solve(x^3+a*x^2+b*x+c,x);`,`   `,
`                                      2`,
`                   1/3   1/3 b - 1/9 a`,
`             <<+4>>    - -------------- - 1/3 a,`,
`                                  1/3`,`                            <<+4>>`,
`   `,`                             1/3         <<+2>>`,
`                 - 1/2 <<+4>>    + 1/2 --------- - 1/3 a + <<*4>>,`,
`                                             1/3`,
`                                       <<+4>>`,`   `,
`                             1/3         <<+2>>`,
`                 - 1/2 <<+4>>    + 1/2 --------- - 1/3 a + <<*4>>`,
`                                             1/3`,
`                                       <<+4>>`,`   `):
#save `sprint.m`;
#quit
