incr-set prlevel 1
if #0>9 START
incr-set prlevel -1
;;; Usage:
;;; 	<lift_arrays w w1 w2 v v1 v2 theta lifts lifts_v1 lifts_v2 k
;;;
;;; Computes comparison maps from the complex (w,v1,v2)
;;; to the complex (v,v1,v2) covering the map theta.  The
;;; liftings are returned in (lifts,lifts_v1,lifts_v2)
;;;
incr-set prlevel 1
jump END
;;; Parameters: (w,w1,w2),(v,v1,v2) arrays of matrices which
;;;                  happen to be complexes
;;;             theta - a matrix giving a map from the first
;;;                  free module of (w,v1,v2) to the first
;;;                  free module of (v,v1,v2)
;;;             k - an integer (optional) giving the number
;;;		     of lifts the computer will attempt to
;;;		     compute.
;;;
;;; Output values:  (lifts,lifts_v1,lifts_v2) An array of
;;;                 matrices containing the liftings.
;;;
;;; 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.
;;;
; created ... 4/9/92
START:

nrows #5 @length
int @k 0
copy #7 @lift

<zeromat 0 0 #8
<zeromat 0 0 #9
<zeromat 0 0 #(10)
<zeromat 0 0 @check
<zeromat 0 0 @diff
<zeromat 0 0 @I
<zeromat 0 0 @J

int @flg 0
if #0=10 LOOP
	int @length #(11)
LOOP:
	int @k @k+1
	<add_matrix_to_array #8 #9 #(10) @lift
	if @k>@length DONE
	<extract_matrix #1 #2 #3 @k @psi
	mult @lift @psi @delta
	<extract_matrix #4 #5 #6 @k @phi
	lift-std @phi @phi
	lift @phi @delta @lift
	
	;;; set the degrees of @lift correctly

	col-degs @psi @cdegs
	col-degs #1.@k @rdegs
	setdegs @lift
		@rdegs
		@cdegs

	;;; check to see if the lift succeeded
	;;; this is based upon the assumption
	;;; that whether or not lift succeeds,
	;;; it does return a matrix of the right
	;;; shape.

	mult @phi @lift @check
	subtract @check @delta @diff
	flatten @diff @I
	compress @I @J
	ncols @J @flg
	if @flg>0 FAIL
jump LOOP

FAIL:
	shout echo 'lift failed at step:'
	shout type @k
DONE:

kill @length @lift @k @psi @delta
kill @check @diff @I @flg @cdegs @rdegs
END:
incr-set prlevel -1

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

<2byn 0 0 2 3 0 2 0 M I

nres I Ires
; 2....3....4....
; computation complete after degree 4

<comp_to_array Ires v v1 v2
<eagon_northcott M en en1 en2
iden 1 theta
<lift_arrays en en1 en2 v v1 v2 theta l l1 l2

<pres l l1 l2
--------------------------------------------------- 
; 1 
--------------------------------------------------- 
; 1 0 0 0 0 0  0 0  0 0 
; 0 1 0 0 0 0  0 0  0 0 
; 0 0 1 0 0 0  0 0  0 0 
; 0 0 0 1 0 -1 0 0  0 0 
; 0 0 0 0 1 0  0 0  0 0 
; 0 0 0 0 0 1  0 0  0 0 
; 0 0 0 0 0 0  1 -1 0 0 
; 0 0 0 0 0 0  0 0  0 1 
--------------------------------------------------- 
; 1 0 0 0 0 0 0  0  0  1  0 0  0 0 0 0  0 0 0  0 
; 0 1 0 1 0 0 0  0  0  0  0 0  0 0 0 0  0 0 0  0 
; 0 0 0 0 0 0 -1 0  0  0  1 -1 0 0 0 0  0 0 0  0 
; 0 0 0 0 0 0 0  -1 -1 0  0 0  0 0 0 0  0 0 0  0 
; 0 0 0 0 0 0 0  0  0  -1 0 0  0 0 0 0  0 0 0  0 
; 0 0 0 0 0 0 0  0  0  0  0 0  0 0 1 0  0 0 -1 0 
; 0 0 0 0 0 0 0  0  0  0  0 -1 0 0 0 0  0 0 0  0 
; 0 0 0 0 0 0 0  0  0  0  0 0  0 1 0 0  0 0 0  0 
; 0 0 0 0 0 0 0  0  0  0  0 0  1 0 1 0  0 0 -1 0 
; 0 0 0 0 0 0 -1 0  0  0  0 0  0 0 0 -1 0 0 0  0 
; 0 0 0 0 0 0 0  0  0  0  0 0  0 0 0 0  1 0 0  0 
; 0 0 0 0 0 0 0  0  0  0  0 0  0 0 0 0  0 1 0  0 
; 0 0 0 0 0 0 0  0  0  0  0 0  0 0 0 0  0 0 -1 0 
; 0 0 0 0 0 0 0  0  0  0  0 0  0 0 0 0  0 0 0  1 
--------------------------------------------------- 
; 0 0 -1 0 0  0  0 0  0  0 0  0 0 0 0  
; 0 0 0  0 -1 0  0 0  0  0 0  0 0 0 0  
; 1 0 0  0 0  0  0 0  0  0 0  0 0 0 0  
; 0 0 0  1 1  0  0 0  0  0 0  0 0 0 0  
; 0 1 0  0 0  0  0 0  0  0 0  0 0 0 0  
; 0 0 0  0 0  0  1 0  0  0 0  0 0 0 0  
; 0 0 0  0 0  -1 0 0  0  0 0  0 0 0 0  
; 0 0 0  0 0  0  0 -1 -1 0 0  0 0 0 0  
; 0 0 0  0 0  -1 0 0  0  0 -1 0 0 0 -1 
--------------------------------------------------- 
; 0 0 0 -1 
; 0 0 1 0  

ed w

ce 2 12 c

<lift_arrays w w1 w2 v v1 v2 theta l l_v1 l_v2
; column #2 not in module
'lift failed at step:' 
; 2

<pres l l_v1 l_v2
--------------------------------------------------- 
; 1 
--------------------------------------------------- 
; 1 0 0 0 0 0  0 0  0 0 
; 0 1 0 0 0 0  0 0  0 0 
; 0 0 1 0 0 0  0 0  0 0 
; 0 0 0 1 0 -1 0 0  0 0 
; 0 0 0 0 1 0  0 0  0 0 
; 0 0 0 0 0 1  0 0  0 0 
; 0 0 0 0 0 0  1 -1 0 0 
; 0 0 0 0 0 0  0 0  0 1 


