Top rank per group: Difference between revisions

Added solution for Action!
(add freebasic)
(Added solution for Action!)
Line 75:
Claire Buckman E39876 27800 D202
David Motsinger E27002 19250 D202
</pre>
 
=={{header|Action!}}==
<lang Action!>DEFINE PTR="CARD"
DEFINE ENTRY_SIZE="8"
 
TYPE Employee=[
PTR name,id,dep ;CHAR ARRAY
CARD salary]
 
BYTE ARRAY data(200)
BYTE count=[0]
 
PTR FUNC GetItemAddr(INT index)
PTR addr
 
addr=data+index*ENTRY_SIZE
RETURN (addr)
 
PROC Append(CHAR ARRAY n,i CARD s CHAR ARRAY d)
Employee POINTER dst
 
dst=GetItemAddr(count)
dst.name=n
dst.id=i
dst.dep=d
dst.salary=s
count==+1
RETURN
 
PROC InitData()
Append("Tyler Bennett","E10297",32000,"D101")
Append("John Rappl","E21437",47000,"D050")
Append("George Woltman","E00127",53500,"D101")
Append("Adam Smith","E63535",18000,"D202")
Append("Claire Buckman","E39876",27800,"D202")
Append("David McClellan","E04242",41500,"D101")
Append("Rich Holcomb","E01234",49500,"D202")
Append("Nathan Adams","E41298",21900,"D050")
Append("Richard Potter","E43128",15900,"D101")
Append("David Motsinger","E27002",19250,"D202")
Append("Tim Sampair","E03033",27000,"D101")
Append("Kim Arlich","E10001",57000,"D190")
Append("Timothy Grove","E16398",29900,"D190")
RETURN
 
PROC Swap(Employee POINTER e1,e2)
PTR tmp
 
tmp=e1.name e1.name=e2.name e2.name=tmp
tmp=e1.id e1.id=e2.id e2.id=tmp
tmp=e1.dep e1.dep=e2.dep e2.dep=tmp
tmp=e1.salary e1.salary=e2.salary e2.salary=tmp
RETURN
 
PROC Sort()
INT i,j,minpos,comp
Employee POINTER e1,e2
 
FOR i=0 TO count-2
DO
minpos=i
FOR j=i+1 TO count-1
DO
e1=GetItemAddr(minpos)
e2=GetItemAddr(j)
comp=SCompare(e1.dep,e2.dep)
IF comp>0 OR comp=0 AND e1.salary<e2.salary THEN
minpos=j
FI
OD
IF minpos#i THEN
e1=GetItemAddr(minpos)
e2=GetItemAddr(i)
Swap(e1,e2)
FI
OD
RETURN
 
PROC TopRank(BYTE n)
BYTE i,c
CHAR ARRAY d
Employee POINTER e
 
i=0
WHILE i<count
DO
e=GetItemAddr(i)
IF i=0 OR SCompare(e.dep,d)#0 THEN
d=e.dep c=0
IF i>0 THEN PutE() FI
PrintF("Department %S:%E",d)
c==+1
PrintF(" %U %S %S%E",e.salary,e.id,e.name)
ELSEIF c<n THEN
c==+1
PrintF(" %U %S %S%E",e.salary,e.id,e.name)
FI
i==+1
OD
RETURN
 
PROC Main()
InitData()
Sort()
TopRank(3)
RETURN</lang>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Top_rank_per_group.png Screenshot from Atari 8-bit computer]
<pre>
Department D050:
47000 E21437 John Rappl
21900 E41298 Nathan Adams
 
Department D101:
53500 E00127 George Woltman
41500 E04242 David McClellan
32000 E10297 Tyler Bennett
 
Department D190:
57000 E10001 Kim Arlich
29900 E16398 Timothy Grove
 
Department D202:
49500 E01234 Rich Holcomb
27800 E39876 Claire Buckman
19250 E27002 David Motsinger
</pre>
 
Anonymous user