#
#--> sprint(x);  or  sprint(x,n);
#
# Input: object to be printed x and (optional) positive integer n (default 100)
# 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	
#	series		<<series[n]>>	series with n terms
#	set		<<set[n]>>	set of n elements
#	list		<<list[n]>>	list of n elements
#	vector		<<vector[n]>>	vector of n elements
#	matrix		<<matrix[m,n]>>	m by n matrix
#	function	<<foo>>		function named foo
#	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.
#
# Author: MBM Apr/90.
#

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 );
macro(	LENGTH = `sprint/length`,
	CAT = `sprint/cat`,
	PRINT = `sprint/sprint` );


sprint := proc(x,m)
    if nargs = 1 then RETURN( sprint(x,M) ) fi;
    if type(m,posint) then print( PRINT(x,m) ); RETURN() fi;
    ERROR(`2nd argument must be a positive integer`)
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,t) local k,l,n;
	
    if type(x,string) and not type(x,{array,table}) then
	l := length(x);
	if l < max(t,N) then x
	else string[l]
	fi

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

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

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

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

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

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

    elif type(x,series) then
	n := nops(x);
	if n < t or LENGTH(x,N) < N then map( PRINT, x, iquo(t,n) )
	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 < t or LENGTH(x,N) < N then map( PRINT, x, iquo(t,n) )
	elif type(op(0,x),string) and length(op(0,x)) < N
	then CAT(`<<`,op(0,x),`>>`)
	else CAT(`<<function>>`)
	fi

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

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

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

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

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

    else map( PRINT, x, iquo(t,nops(x)) )
    fi

end:

save `sprint.m`;
quit
