RosettaCodeData/Task/Top-rank-per-group/IS-BASIC/top-rank-per-group.basic
2023-07-01 13:44:08 -04:00

51 lines
1.5 KiB
Text

100 PROGRAM "Employee.bas"(N)
110 LET NR=100:LET X=0
120 STRING NAME$(1 TO NR)*20,ID$(1 TO NR)*6,DEPT$(1 TO NR)*4
130 NUMERIC SALARY(1 TO NR)
140 DO UNTIL N>0 AND N<=NR
150 INPUT PROMPT "Enter the number of ranks: ":N$
160 LET N=VAL(N$)
170 LOOP
180 CALL READDATA
190 CALL SORT
200 CALL LST
210 END
220 DEF READDATA
230 LET EOF=0
240 OPEN #1:"Employee.dat"
250 WHEN EXCEPTION USE IOERROR
260 DO
270 LET X=X+1
280 INPUT #1:NAME$(X),ID$(X),SALARY(X),DEPT$(X)
290 LOOP UNTIL EOF OR X=NR
300 END WHEN
310 HANDLER IOERROR
320 IF EXTYPE<>8001 THEN PRINT EXSTRING$(EXTYPE)
330 CLOSE #1
340 LET X=X-1:LET EOF=-1
350 IF X=0 THEN PRINT "No data.":STOP
360 CONTINUE
370 END HANDLER
380 END DEF
390 DEF SORT
400 LET GAP=X:LET SW=1
410 DO WHILE GAP>1 OR SW
420 LET GAP=MAX(INT(GAP/1.3),1):LET SW=0
430 FOR I=1 TO X-GAP
440 IF DEPT$(I)>DEPT$(I+GAP) OR DEPT$(I)=DEPT$(I+GAP) AND SALARY(I)<SALARY(I+GAP) THEN
450 LET T$=NAME$(I):LET NAME$(I)=NAME$(I+GAP):LET NAME$(I+GAP)=T$
460 LET T$=DEPT$(I):LET DEPT$(I)=DEPT$(I+GAP):LET DEPT$(I+GAP)=T$
470 LET T$=ID$(I):LET ID$(I)=ID$(I+GAP):LET ID$(I+GAP)=T$
480 LET T=SALARY(I):LET SALARY(I)=SALARY(I+GAP):LET SALARY(I+GAP)=T
490 LET SW=1
500 END IF
510 NEXT
520 LOOP
530 END DEF
540 DEF LST
550 LET J=1:LET PREV$=""
560 FOR I=1 TO X
570 IF DEPT$(I)<>PREV$ THEN PRINT "Department ";DEPT$(I):LET PREV$=DEPT$(I):LET J=1
580 IF J<=N THEN PRINT " ";NAME$(I);TAB(23);ID$(I),SALARY(I):LET J=J+1
590 NEXT
600 END DEF