Range consolidation: Difference between revisions

Added solution for Action!
(Added solution for Action!)
Line 98:
[4, 3], [2, 1], [-1, -2], [3.9, 10] => [-2, -1], [1, 2], [3, 10]
[1, 3], [-6, -1], [-4, -5], [8, 2], [-6, -6] => [-6, -1], [1, 8]
</pre>
 
=={{header|Action!}}==
{{libheader|Action! Tool Kit}}
{{libheader|Action! Real Math}}
<lang Action!>INCLUDE "H6:REALMATH.ACT"
 
DEFINE PTR="CARD"
DEFINE RANGESIZE="12"
DEFINE LOW_="+0"
DEFINE HIGH_="+6"
TYPE Range=[CARD l1,l2,l3,h1,h2,h3]
 
PROC Inverse(Range POINTER r)
REAL tmp
 
RealAssign(r LOW_,tmp)
RealAssign(r HIGH_,r LOW_)
RealAssign(tmp,r HIGH_)
RETURN
 
PROC Normalize(Range POINTER r)
IF RealLess(r HIGH_,r LOW_) THEN
Inverse(r)
FI
RETURN
 
INT FUNC Compare(Range Pointer r1,r2)
IF RealLess(r1 LOW_,r2 LOW_) THEN
RETURN (-1)
ELSEIF RealLess(r2 LOW_,r1 LOW_) THEN
RETURN (1)
ELSEIF RealLess(r1 HIGH_,r2 HIGH_) THEN
RETURN (-1)
ELSEIF RealLess(r2 HIGH_,r1 HIGH_) THEN
RETURN (1)
FI
RETURN (0)
 
PTR FUNC GetItemAddr(PTR data INT index)
RETURN (data+index*RANGESIZE)
 
PROC Swap(Range POINTER r1,r2)
REAL tmp
 
RealAssign(r1 LOW_,tmp)
RealAssign(r2 LOW_,r1 LOW_)
RealAssign(tmp, r2 LOW_)
RealAssign(r1 HIGH_,tmp)
RealAssign(r2 HIGH_,r1 HIGH_)
RealAssign(tmp, r2 HIGH_)
RETURN
 
PROC Sort(PTR data INT count)
INT i,j,minpos
Range POINTER r1,r2
 
FOR i=0 TO count-2
DO
minpos=i
FOR j=i+1 TO count-1
DO
r1=GetItemAddr(data,minpos)
r2=GetItemAddr(data,j)
IF Compare(r1,r2)>0 THEN
minpos=j
FI
OD
IF minpos#i THEN
r1=GetItemAddr(data,minpos)
r2=GetItemAddr(data,i)
Swap(r1,r2)
FI
OD
RETURN
 
PROC Consolidate(PTR data INT POINTER count)
INT i,j,newCount
Range POINTER r1,r2
 
FOR i=0 TO count^-1
DO
r1=GetItemAddr(data,i)
Normalize(r1)
OD
Sort(data,count^)
 
newCount=0 i=0
WHILE i<count^
DO
j=i+1
WHILE j<count^
DO
r1=GetItemAddr(data,i)
r2=GetItemAddr(data,j)
IF RealLess(r1 HIGH_,r2 LOW_) THEN
EXIT
ELSEIF RealLess(r1 HIGH_,r2 HIGH_) THEN
RealAssign(r2 HIGH_,r1 HIGH_)
FI
j==+1
OD
r1=GetItemAddr(data,i)
r2=GetItemAddr(data,newCount)
RealAssign(r1 LOW_,r2 LOW_)
RealAssign(r1 HIGH_,r2 HIGH_)
newCount==+1
i=j
OD
count^=newCount
RETURN
 
PROC PrintRanges(PTR data INT count)
INT i
Range POINTER r
 
FOR i=0 TO count-1
DO
IF i>0 THEN Put(' ) FI
r=GetItemAddr(data,i)
Put('[) PrintR(r LOW_)
Put(',) PrintR(r HIGH_) Put('])
OD
RETURN
 
PROC Append(PTR data INT POINTER count
CHAR ARRAY sLow,sHigh)
Range POINTER r
 
r=GetItemAddr(data,count^)
ValR(sLow,r LOW_)
ValR(sHigh,r High_)
count^=count^+1
RETURN
 
INT FUNC InitData(BYTE case PTR data)
INT count
 
count=0
IF case=0 THEN
Append(data,@count,"1.1","2.2")
ELSEIF case=1 THEN
Append(data,@count,"6.1","7.2")
Append(data,@count,"7.2","8.3")
ELSEIF case=2 THEN
Append(data,@count,"4","3")
Append(data,@count,"2","1")
ELSEIF case=3 THEN
Append(data,@count,"4","3")
Append(data,@count,"2","1")
Append(data,@count,"-1","-2")
Append(data,@count,"3.9","10")
ELSEIF case=4 THEN
Append(data,@count,"1","3")
Append(data,@count,"-6","-1")
Append(data,@count,"-4","-5")
Append(data,@count,"8","2")
Append(data,@count,"-6","-6")
FI
RETURN (count)
 
PROC Main()
BYTE ARRAY data(100)
INT count
BYTE i
 
Put(125) PutE() ;clear the screen
FOR i=0 TO 4
DO
count=InitData(i,data)
PrintRanges(data,count)
Print(" -> ")
Consolidate(data,@count)
PrintRanges(data,count)
PutE() PutE()
OD
RETURN</lang>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Range_consolidation.png Screenshot from Atari 8-bit computer]
<pre>
[1.1,2.2] -> [1.1,2.2]
 
[6.1,7.2] [7.2,8.3] -> [6.1,8.3]
 
[4,3] [2,1] -> [1,2] [3,4]
 
[4,3] [2,1] [-1,-2] [3.9,10] -> [-2,-1] [1,2] [3,10]
 
[1,3] [-6,-1] [-4,-5] [8,2] [-6,-6] -> [-6,-1] [1,8]
</pre>
 
Anonymous user