Priority queue: Difference between revisions

Content added Content deleted
(SAS: Add error test for the revised %HeapPop macro)
(Update SAS: show example using proc ds2)
Line 5,629: Line 5,629:
=={{header|SAS}}==
=={{header|SAS}}==
Using macros in a SAS data step:
Using macros in a SAS data step:
<lang sas>
<lang sas>%macro HeapInit(size=1000,nchar=20);
%macro HeapInit(size=1000,nchar=20);
do;
do;
_len = 0;
_len = 0;
Line 5,725: Line 5,724:
%HeapPop;
%HeapPop;
end;
end;
run;
run;</lang>
</lang>
{{output}}
{{output}}
<pre>1 Solve RC tasks
<pre>1 Solve RC tasks
Line 5,734: Line 5,732:
5 Make tea</pre>
5 Make tea</pre>


We can reduce the namespace pollution using <code>proc fcmp</code>. Adapting the above code, we drop the
An implementation using <code>proc ds2</code> may be more structured:
<lang sas>proc ds2;
<code>%HeapSwapItem</code>, <code>%HeapSiftdown</code> and <code>%HeapSiftup</code> macros and replace
package Heap / overwrite=yes;
the <code>%HeapPush</code> and <code>%HeapPop</code> macros. For the test code, we get the same output.
dcl int _entryorder _size _len _entryOrders[1000];
<lang sas>
dcl double _times[1000];
proc fcmp outlib=sasuser.funcs.trial;
dcl varchar(20) _kinds[1000];
subroutine HeapSwapItem(index1, index2, _times[*], _kinds[*] $);
method init();
outargs _times, _kinds;
_entryOrder = 1;
length tempC $ 20;
_size = 1000;
tempN = _times[index1]; _times[index1] = _times[index2]; _times[index2]= tempN;
_len = 0;
tempC = _kinds[index1]; _kinds[index1] = _kinds[index2]; _kinds[index2]= tempC;
endsub;
subroutine HeapSiftdown(index, _len, _times[*],_kinds[*] $);
outargs _times, _kinds;
parent = index;
done = 0;
do while (parent*2 <= _len and ^done);
child = parent*2;
if (child+1 <= _len and %HeapCompare(child+1,child)) then
child = child + 1;
if %HeapCompare(child,parent) then do;
call HeapSwapItem(child,parent, _times, _kinds);
parent = child;
end;
else done = 1;
end;
end;
method empty() returns int;
endsub;
return(_len=0);
subroutine HeapSiftup(index, _len, _times[*], _kinds[*] $);
end;
outargs _times, _kinds;
method compare(int index1, int index2) returns int;
child = index;
return(_times[index1] < _times[index2] or (_times[index1] = _times[index2] and _entryOrders[index1] < _entryOrders[index2]));
done = 0;
end;
do while(child>1 and ^done);
method SetItem(int index, double _time, int entryOrder, varchar(20) kind);
parent = floor(child/2);
_times[index] = _time;
if %HeapCompare(parent,child) then
_entryOrders[index] = entryOrder;
done = 1;
_kinds[index] = kind;
else do;
end;
call HeapSwapItem(child,parent, _times, _kinds);
method CopyItem(int ito, int ifrom);
tempN = child;
_times[ito] = _times[ifrom];
child = parent;
_entryOrders[ito] = _entryOrders[ifrom];
parent = tempN;
_kinds[ito] = _kinds[ifrom];
end;
method SwapItem(int index1, int index2);
dcl double tempD;
dcl int tempI;
dcl varchar(20) tempC;
tempD = _times[index1]; _times[index1] = _times[index2]; _times[index2]= tempD;
tempI = _entryorders[index1]; _entryorders[index1] = _entryorders[index2]; _entryorders[index2]= tempI;
tempC = _kinds[index1]; _kinds[index1] = _kinds[index2]; _kinds[index2]= tempC;
end;
method Siftdown(int index);
dcl int parent done child;
parent = index;
done = 0;
do while (parent*2 <= _len and ^done);
child = parent*2;
if (child+1 <= _len and Compare(child+1,child)) then
child = child + 1;
if Compare(child,parent) then do;
SwapItem(child,parent);
parent = child;
end;
else done = 1;
end;
end;
end;
end;
method Siftup(int index);
endsub;
dcl int parent child done tempI;
run;
child = index;
options cmplib=sasuser.funcs;
done = 0;
%macro HeapPop;
do while(child>1 and ^done);
do;
parent = floor(child/2);
if _len >= _size then do;
if Compare(parent,child) then
put "ERROR: exceeded size of heap. Consider changing size argument to %HeapInit.";
stop;
done = 1;
else do;
SwapItem(child,parent);
tempI = child;
child = parent;
parent = tempI;
end;
end;
end;
end;
method Pop();
_len = _len - 1;
_len = _len - 1;
if (_len>0) then do;
if (_len>0) then do;
_times[1] = _times[_len+1];
CopyItem(1,_len+1);
Siftdown(1);
_kinds[1] = _kinds[_len+1];
call HeapSiftdown(1, _len, _times, _kinds);
end;
end;
end;
end;
method PeekTime() returns double;
%mend;
return _times[1];
%macro HeapPush(time, kind);
do;
end;
method PeekKind() returns varchar(20);
return _kinds[1];
end;
method Push(double _time, varchar(20) kind);
if _len >= _size then do;
put 'ERROR: exceeded size of heap.';
stop;
end;
_len = _len + 1;
_len = _len + 1;
_entryOrder = _entryOrder + 1;
_times[_len] = &time;
_kinds[_len] = &kind;
SetItem(_len, _time, _entryOrder, kind);
Siftup(_len);
call HeapSiftup(_len, _len, _times, _kinds);
end;
end;
endpackage;
%mend;
run;
</lang>
data _null_;
dcl package Heap h();
method init();
dcl double _time;
dcl varchar(20) _kind;
h.init();
h.Push(3, 'Clear drains');
h.Push(4, 'Feed cat');
h.Push(5, 'Make tea');
h.Push(1, 'Solve RC tasks');
h.Push(2, 'Tax return');
do while(^h.empty());
_time = h.PeekTime();
_kind = h.PeekKind();
put _time _kind;
h.Pop();
end;
end;
enddata;
run;</lang>


=={{header|Scala}}==
=={{header|Scala}}==
Retrieved from "https://rosettacode.org/wiki/Priority_queue"