130 lines
5.5 KiB
Plaintext
130 lines
5.5 KiB
Plaintext
* Closest Pair Problem 10/03/2017
|
|
CLOSEST CSECT
|
|
USING CLOSEST,R13 base register
|
|
B 72(R15) skip savearea
|
|
DC 17F'0' savearea
|
|
STM R14,R12,12(R13) save previous context
|
|
ST R13,4(R15) link backward
|
|
ST R15,8(R13) link forward
|
|
LR R13,R15 set addressability
|
|
LA R6,1 i=1
|
|
LA R7,2 j=2
|
|
BAL R14,DDCALC dd=(px(i)-px(j))^2+(py(i)-py(j))^2
|
|
BAL R14,DDSTORE ddmin=dd; ii=i; jj=j
|
|
LA R6,1 i=1
|
|
DO WHILE=(C,R6,LE,N) do i=1 to n
|
|
LA R7,1 j=1
|
|
DO WHILE=(C,R7,LE,N) do j=1 to n
|
|
BAL R14,DDCALC dd=(px(i)-px(j))^2+(py(i)-py(j))^2
|
|
IF CP,DD,GT,=P'0' THEN if dd>0 then
|
|
IF CP,DD,LT,DDMIN THEN if dd<ddmin then
|
|
BAL R14,DDSTORE ddmin=dd; ii=i; jj=j
|
|
ENDIF , endif
|
|
ENDIF , endif
|
|
LA R7,1(R7) j++
|
|
ENDDO , enddo j
|
|
LA R6,1(R6) i++
|
|
ENDDO , enddo i
|
|
ZAP WPD,DDMIN ddmin
|
|
DP WPD,=PL8'2' ddmin/2
|
|
ZAP SQRT2,WPD(8) sqrt2=ddmin/2
|
|
ZAP SQRT1,DDMIN sqrt1=ddmin
|
|
DO WHILE=(CP,SQRT1,NE,SQRT2) do while sqrt1<>sqrt2
|
|
ZAP SQRT1,SQRT2 sqrt1=sqrt2
|
|
ZAP WPD,DDMIN ddmin
|
|
DP WPD,SQRT1 /sqrt1
|
|
ZAP WP1,WPD(8) ddmin/sqrt1
|
|
AP WP1,SQRT1 +sqrt1
|
|
ZAP WPD,WP1 ~
|
|
DP WPD,=PL8'2' /2
|
|
ZAP SQRT2,WPD(8) sqrt2=(sqrt1+(ddmin/sqrt1))/2
|
|
ENDDO , enddo while
|
|
MVC PG,=CL80'the minimum distance '
|
|
ZAP WP1,SQRT2 sqrt2
|
|
BAL R14,EDITPK edit
|
|
MVC PG+21(L'WC),WC output
|
|
XPRNT PG,L'PG print buffer
|
|
XPRNT =CL22'is between the points:',22
|
|
MVC PG,PGP init buffer
|
|
L R1,II ii
|
|
SLA R1,4 *16
|
|
LA R4,PXY-16(R1) @px(ii)
|
|
MVC WP1,0(R4) px(ii)
|
|
BAL R14,EDITPK edit
|
|
MVC PG+3(L'WC),WC output
|
|
MVC WP1,8(R4) py(ii)
|
|
BAL R14,EDITPK edit
|
|
MVC PG+21(L'WC),WC output
|
|
XPRNT PG,L'PG print buffer
|
|
MVC PG,PGP init buffer
|
|
L R1,JJ jj
|
|
SLA R1,4 *16
|
|
LA R4,PXY-16(R1) @px(jj)
|
|
MVC WP1,0(R4) px(jj)
|
|
BAL R14,EDITPK edit
|
|
MVC PG+3(L'WC),WC output
|
|
MVC WP1,8(R4) py(jj)
|
|
BAL R14,EDITPK edit
|
|
MVC PG+21(L'WC),WC output
|
|
XPRNT PG,L'PG print buffer
|
|
L R13,4(0,R13) restore previous savearea pointer
|
|
LM R14,R12,12(R13) restore previous context
|
|
XR R15,R15 rc=0
|
|
BR R14 exit
|
|
DDCALC EQU * ---- dd=(px(i)-px(j))^2+(py(i)-py(j))^2
|
|
LR R1,R6 i
|
|
SLA R1,4 *16
|
|
LA R4,PXY-16(R1) @px(i)
|
|
LR R1,R7 j
|
|
SLA R1,4 *16
|
|
LA R5,PXY-16(R1) @px(j)
|
|
ZAP WP1,0(8,R4) px(i)
|
|
ZAP WP2,0(8,R5) px(j)
|
|
SP WP1,WP2 px(i)-px(j)
|
|
ZAP WPS,WP1 =
|
|
MP WP1,WPS (px(i)-px(j))*(px(i)-px(j))
|
|
ZAP WP2,8(8,R4) py(i)
|
|
ZAP WP3,8(8,R5) py(j)
|
|
SP WP2,WP3 py(i)-py(j)
|
|
ZAP WPS,WP2 =
|
|
MP WP2,WPS (py(i)-py(j))*(py(i)-py(j))
|
|
AP WP1,WP2 (px(i)-px(j))^2+(py(i)-py(j))^2
|
|
ZAP DD,WP1 dd=(px(i)-px(j))^2+(py(i)-py(j))^2
|
|
BR R14 ---- return
|
|
DDSTORE EQU * ---- ddmin=dd; ii=i; jj=j
|
|
ZAP DDMIN,DD ddmin=dd
|
|
ST R6,II ii=i
|
|
ST R7,JJ jj=j
|
|
BR R14 ---- return
|
|
EDITPK EQU * ----
|
|
MVC WM,MASK set mask
|
|
EDMK WM,WP1 edit and mark
|
|
BCTR R1,0 -1
|
|
MVC 0(1,R1),WM+17 set sign
|
|
MVC WC,WM len17<-len18
|
|
BR R14 ---- return
|
|
N DC A((PGP-PXY)/16)
|
|
PXY DC PL8'0.654682',PL8'0.925557',PL8'0.409382',PL8'0.619391'
|
|
DC PL8'0.891663',PL8'0.888594',PL8'0.716629',PL8'0.996200'
|
|
DC PL8'0.477721',PL8'0.946355',PL8'0.925092',PL8'0.818220'
|
|
DC PL8'0.624291',PL8'0.142924',PL8'0.211332',PL8'0.221507'
|
|
DC PL8'0.293786',PL8'0.691701',PL8'0.839186',PL8'0.728260'
|
|
PGP DC CL80' [+xxxxxxxxx.xxxxxx,+xxxxxxxxx.xxxxxx]'
|
|
MASK DC C' ',7X'20',X'21',X'20',C'.',6X'20',C'-' CL18 15num
|
|
II DS F
|
|
JJ DS F
|
|
DD DS PL8
|
|
DDMIN DS PL8
|
|
SQRT1 DS PL8
|
|
SQRT2 DS PL8
|
|
WP1 DS PL8
|
|
WP2 DS PL8
|
|
WP3 DS PL8
|
|
WPS DS PL8
|
|
WPD DS PL16
|
|
WM DS CL18
|
|
WC DS CL17
|
|
PG DS CL80
|
|
YREGS
|
|
END CLOSEST
|