Sync

Task/Sorting-algorithms-Heapsort/PL-I/sorting-algorithms-heapsort.pli

@@ -0,0 +1,76 @@
+*process source xref attributes or(!);
+ /*********************************************************************
+ * Pseudocode found here:
+ *   http://en.wikipedia.org/wiki/Heapsort#Pseudocode
+ * Sample data from REXX
+ * 27.07.2013 Walter Pachl
+ *********************************************************************/
+ heaps: Proc Options(main);
+ Dcl a(0:25) Char(50) Var Init(
+      '---letters of the modern Greek Alphabet---',
+      '==========================================',
+      'alpha','beta','gamma','delta','epsilon','zeta','eta','theta',
+      'iota','kappa','lambda','mu','nu','xi','omicron','pi',
+      'rho','sigma','tau','upsilon','phi','chi','psi','omega');
+ Dcl n Bin Fixed(31) Init((hbound(a)+1));
+
+ Call showa('before sort');
+ Call heapsort((n));
+ Call showa(' after sort');
+
+ heapSort: Proc(count);
+   Dcl (count,end) Bin Fixed(31);
+   Call heapify((count));
+   end=count-1;
+   do while(end>0);
+     Call swap(end,0);
+     end=end-1;
+     Call siftDown(0,(end));
+     End;
+   End;
+
+ heapify: Proc(count);
+   Dcl (count,start) Bin Fixed(31);
+   start=(count-2)/2;
+   Do while (start>=0);
+     Call siftDown((start),count-1);
+     start=start-1;
+     End;
+   End;
+
+ siftDown: Proc(start,end);
+   Dcl (count,start,root,end,child,sw) Bin Fixed(31);
+   root=start;
+   Do while(root*2+1<= end);
+     child=root*2+1;
+     sw=root;
+     if a(sw)<a(child) Then
+       sw=child;
+     if child+1<=end & a(sw)<a(child+1) Then
+       sw=child+1;
+     if sw^=root Then Do;
+       Call swap(root,sw);
+       root=sw;
+       End;
+     else
+       return;
+     End;
+   End;
+
+ swap: Proc(x,y);
+ Dcl (x,y) Bin Fixed(31);
+ Dcl temp Char(50) Var;
+   temp=a(x);
+   a(x)=a(y);
+   a(y)=temp;
+   End;
+
+ showa: Proc(txt);
+ Dcl txt Char(*);
+ Dcl j Bin Fixed(31);
+ Do j=0 To hbound(a);
+   Put Edit('element',j,txt,a(j))(skip,a,f(3),x(1),a,x(1),a);
+   End;
+ End;
+
+ End;