incr-set prlevel 1
if #0=7 START
incr-set prlevel -1
;;; Usage:
;;; 	<ring_change M f tot tot1 tot2 tot3 tot4
;;;
;;; Given a module presented by M and an
;;; element f over the same ring, anni-
;;; hilating M, return the double complex
;;; needed to compute the change of rings
;;; spectral sequence.
;;;
;;; (tot,tot1,tot2) will contain the total complex
;;; in array of matrices format, and (tot3,tot4)
;;; contain the add'l information neccessary to
;;; retrieve the double complex.
;;;
;;; The Array of Matrices Data Type:
;;;
;;; An array of matrices is a triple (M,v1,v2) of matrices.
;;; The first coordinate is a direct sum of matrices such
;;; that the upper left hand corner is thought of as the
;;; first matrix, and so on.
;;;
;;; The second coordinate is an n by 0 matrix whose row
;;; degrees give the ranks of the free modules which are
;;; the sources of the maps.
;;;
;;; The third coordinate is an n by 0 matrix whose row de-
;;; grees give the ranks of the free modules which are the
;;; targets of the maps.

incr-set prlevel 1
jump END
;;; Parameters:
;;;
;;; Output values:
;;;
;;; (discussion)
;;;
;;; Caveats:
;;;
; created ...
START:

;;; Compute a resolution of the module M
;;; and use the matrices to represent a
;;; complex over the quotient ring.

nres #1 @r 5
<pd @r @pdim

<comp_to_array @r @res @res1 @res2
std #2 #2
qring #2 @Q
fetch @res @res
fetch @res1 @res1
fetch @res2 @res2

<zeromat 0 2 #6
<zeromat 1 0 #7

int @i 0

	;;; Fix a resolution of the image of tzero.
	;;; This resolution is chosen so that an identity
	;;; matrix will always serve to present the map
	;;; @phi from Sj to im(@tj).

	<extract_matrix @res @res1 @res2 1 @init_mat
	nrows @init_mat @size
	iden @size @top
	<zeromat @size @size @bottom
	<stack @F' @top @bottom
	<zeromat 2 0 @F1'
	setdegs @F1'
		@size 0
		;
	<zeromat 2 0 @F2'
	setdegs @F2'
		@size @size
		;

LOOP:

	<extract_matrix @res @res1 @res2 @i+1 @tjplusone
	if @i>0 BR1
		nrows @tjplusone @ncols
		<zeromat 0 @ncols @tj
		jump BR2
	BR1:
		<extract_matrix @res @res1 @res2 @i @tj
	BR2:
	
	;;; compute a presenting map for im(@tjplusone)
	;;;
	syz @tjplusone -1 @F1
	
	;;; compute a presenting map for ker(@tj)
	;;;
	syz @tj -1 @ker_tj
	syz @ker_tj -1 @G
	  
	;;; lift to get a map from F/0 to G/0
	;;;
	lift-std @ker_tj @ker_tj
	lift @ker_tj @tjplusone @phi

	;;; Use the degrees of @tjplusone and @ker_tj
	;;; to set the degrees of @phi correctly
	;;;
	col-degs @tjplusone @cdegs
	col-degs @ker_tj @rdegs
	setdegs @phi
		@rdegs
		@cdegs

	nrows @phi @rkG
	iden @rkG @psi
	setdegs @psi
		@rdegs

	<zeromat @rkG 0 @H1
	setdegs @H1
		@rdegs
		;
	concat @H1 @G @phi
	
	nres @F1 @Fres 5
	<comp_to_array @Fres @F @F1 @F2
	nres @H1 @Hres 5
	<comp_to_array @Hres @H @H1 @H2

	;;; fill in the horseshoe to get a resolution
	;;; of ker(@tj)

	<splice_resns @F @F1 @F2 @G @G1 @G2 @H @H1 @H2 @phi @psi

	;;; reconstruct the map going from F/0 + H/0 to G/0
	;;;
	ncols @psi @rows_to_retain
	nrows @psi @nrows
	<zeromat @nrows 0 @sum_map
	<extract_matrix @H @H1 @H2 1 @h_map
	row-degs @h_map @rdegs
	setdegs @sum_map
		@rdegs
		;
	concat @sum_map @psi @h_map
	lift-std @sum_map @sum_map
	iden @nrows @iden
	setdegs @iden
		@rdegs
		@rdegs
	lift @sum_map @iden @lift1
	col-degs @sum_map @rdegs
	row-degs @sum_map @cdegs
	setdegs @lift1
		@rdegs
		@cdegs
	submat @lift1 @lift1
		1..@rows_to_retain
		;
	concat @phi @lift1
	mult @ker_tj @phi @phi

	;;; The presenting map for Sj should be
	;;; a rk(Sj) x 0 mat
	;;;	
	ncols @tj @rk_Sj
	<zeromat @rk_Sj 0 @C
	col-degs @tj @Sj_degs
	setdegs @C
		@Sj_degs
		;

	;;; From the previous construction of @F' @F1' @F2'
	;;; we know that @psi is represented by an identity
	;;; matrix of size rk_Sj
	;;;
	iden @rk_Sj @psi
	setdegs @psi
		@Sj_degs
		@Sj_degs

	;;; Fill in the horseshoe to get a resolution of Sj
	;;; which induces the desired map on kernels, images
	;;; and homology

;		shout type @i
;		shout echo
;		shout <pres @G @G1 @G2
;		shout echo
;		shout <pres @F' @F1' @F2'
;		shout type @phi
;		shout row-degs @phi
;		shout col-degs @phi
;		shout type @psi
;		shout row-degs @psi
;		shout col-degs @psi
;		shout type @C
;		shout col-degs @C
;		shout row-degs @C		

	<splice_resns @G @G1 @G2 @C @C1 @C2 @F' @F1' @F2' @phi @psi

	;;; Compute the 'augmentation' map from the 0th free module
	;;; in (@C,@C1,@C2) to Sj.

	ncols @psi @rows_to_retain
	nrows @psi @nrows
	<zeromat @nrows 0 @sum_map
	<extract_matrix @F' @F1' @F2' 1 @f'_map
	row-degs @f'_map @rdegs
	setdegs @sum_map
		@rdegs
		;
	concat @sum_map @psi @f'_map
	lift-std @sum_map @sum_map
	iden @nrows @iden
	setdegs @iden
		@rdegs
		@rdegs
	lift @sum_map @iden @lift1
	col-degs @sum_map @rdegs
	row-degs @sum_map @cdegs
	setdegs @lift1
		@rdegs
		@cdegs
	submat @lift1 @lift1
		1..@rows_to_retain
		;
	concat @phi @lift1
	
	;;; Now 'prepend' this matrix to the complex (@C,@C1,@C2)
	;;;
	<prepend_matrix_to_array @C @C1 @C2 @phi

	<truncate_array @C @C1 @C2 5

	;;; Save the ranks (5 of them) of the free modules
	;;; of the complex C as part of the column vector tot4

	copy @C2 @rks
	transpose @rks @rks
	nrows @C1 @nr
	row-degree @C1 @nr @last_rk_value
	<zeromat 0 1 @last_rk
	setdegs @last_rk
		;
		-@last_rk_value
	concat #7 @rks @last_rk
	<zeromat 0 0 @res_Sj_rks
	concat @res_Sj_rks @rks @last_rk


	;;; When its all done we'll divide by five
	;;; and decide how many rows and columns
	;;; the matrix (whose entries are held by
	;;; tot4) should have.

	if @i>0 BR5

		;;; If this is the first complex that	
		;;; we are adding, then just copy
		;;; it into the (tot,tot1,tot2)

		copy @C #3
		copy @C1 #4
		copy @C2 #5

		jump BR6
	BR5:
		int @k 0
	
		<zeromat 0 0 @map
		<zeromat 0 1 @map1
		<zeromat 0 1 @map2

		LOOP3:
			if @k=5+@i-1 GETLASTRK
				<extract_matrix #3 #4 #5 @k+1 @mat2
				row-degs @mat2 @row_degs
				nrows @mat2 @nrows
			jump BRANCH9
			GETLASTRK:
				<extract_matrix #3 #4 #5 @k @mat3
				col-degs @mat3 @row_degs
				ncols @mat3 @nrows
			BRANCH9:

			if @k>=@i-1 BR7
				int @ncols 0
				mat @col_degs
					0
					0	
				mat @Z
					@nrows
					@ncols
				setdegs @Z
					@row_degs
					@col_degs
			jump ADDMAT

			BR7:
				col-degree @res_Sj_rks @k-@i+2 @ncols
				<extract_matrix @C @C1 @C2 @k-@i+2 @mat1
				row-degs @mat1 @col_degs
				int @ncols -@ncols
			if @k=@i-1 USETJ
				col-degree @im_t_rks @k-@i+1 @iden_block_rk
				int @iden_block_rk -@iden_block_rk
			<zeromat @iden_block_rk @ncols-@iden_block_rk @Z1
				iden @iden_block_rk @Z2
				concat @Z1 @Z2
				<zeromat @nrows-@iden_block_rk @ncols @Z3
				<stack @Z @Z1 @Z3
				setdegs @Z
					@row_degs
					@col_degs
			jump ADDMAT
			USETJ:
				copy @tj @Z1
				nrows @Z1 @rows_already
				<zeromat @nrows-@rows_already @ncols @Z2
				<stack @Z @Z1 @Z2
				setdegs @Z
					@row_degs
					@col_degs			
			ADDMAT:
				<add_matrix_to_array @map @map1 @map2 @Z
			int @k @k+1
			if @k-@i<5 LOOP3
						
		int @k 0
		LOOP4:
			if @k>=@i-1 BREAKLOOP4
			<extract_matrix @C @C1 @C2 1 @mat3
			nrows @mat3 @ncols
			row-degs @mat3 @col_degs
			<zeromat 0 @ncols @Z
			setdegs @Z
				0
				@col_degs
			<prepend_matrix_to_array @C @C1 @C2 @Z
			int @k @k+1
			jump LOOP4
		BREAKLOOP4:			
	
		<mc @C @C1 @C2 #3 #4 #5 @map @map1 @map2 @mc @mc1 @mc2

		copy @mc #3
		copy @mc1 #4
		copy @mc2 #5
	BR6:

	;;; Save the ranks of the currently forming
	;;; mapping cylinder for use when constructng
	;;; the next morphism between complexes.

		copy #5 @rks
		transpose @rks @rks
		nrows #4 @nr
		row-degree #4 @nr @last_rk_value
		<zeromat 0 1 @last_rk
		setdegs @last_rk
			;
			-@last_rk_value
		<zeromat 0 0 @mc_rks
		concat @mc_rks @rks @last_rk

	;;; save the ranks of (im @tjplusone) to
	;;; use in the next loop
		
		<truncate_array @F @F1 @F2 5

		copy @F2 @rks
		transpose @rks @rks
			nrows @F1 @nr
		row-degree @F1 @nr @last_rk_value
		<zeromat 0 1 @last_rk
		setdegs @last_rk
			;
			-@last_rk_value
		<zeromat 0 0 @im_t_rks
		concat @im_t_rks @rks @last_rk

	;;; Save the resolution of im(@tplusone)
	;;; because it is used, although in a
	;;; diffferent place in the next reso-
	;;; lution.
	
	copy @F @F'
	copy @F1 @F1'
	copy @F2 @F2'
	int @i @i+1

if @i<=@pdim LOOP

ncols #7 @totcols
setdegs #6
	;
	5 (@totcols)/5
transpose #7 #7

END:
incr-set prlevel -1

$;;;;;;;; EXAMPLE SECTION ;;;;;;;;;;;;;;;;;;;;;;;;;


