Data update

Task/Sorting-algorithms-Patience-sort/FreeBASIC/sorting-algorithms-patience-sort.basic

@@ -0,0 +1,58 @@
+Sub patienceSort(bs() As Long)
+    Dim As Long i, j, min, pickedRow
+    Dim As Long lb = Lbound(bs), ub = Ubound(bs)
+    Dim As Long decks(ub, ub)
+    Dim As Long count(ub)
+    Dim As Long sortedArr(ub)
+
+    For i = lb To ub
+        For j = lb To ub
+            If count(j) = 0 Or (count(j) > 0 And decks(j, count(j) - 1) >= bs(i)) Then
+                decks(j, count(j)) = bs(i)
+                count(j) += 1
+                Exit For
+            End If
+        Next
+    Next
+
+    min = decks(0, count(0) - 1)
+    pickedRow = 0
+
+    For i = lb To ub
+        For j = lb To ub
+            If count(j) > 0 And decks(j, count(j) - 1) < min Then
+                min = decks(j, count(j) - 1)
+                pickedRow = j
+            End If
+        Next
+        sortedArr(i) = min
+        count(pickedRow) -= 1
+
+        For j = lb To ub
+            If count(j) > 0 Then
+                min = decks(j, count(j) - 1)
+                pickedRow = j
+                Exit For
+            End If
+        Next
+    Next
+
+    For i = 0 To ub
+        bs(i) = sortedArr(i)
+    Next
+End Sub
+
+'--- Programa Principal ---
+Dim As Long i
+Dim As Long array(14) = {-5,-3, 0,-7, 5, 2, 3, 6,-6,-1, 1,-2, 4, 7,-4}
+Dim As Long a = Lbound(array), b = Ubound(array)
+
+Print "unsort ";
+For i = a To b : Print Using "####"; array(i); : Next i
+
+patienceSort(array())
+
+Print !"\n  sort ";
+For i = a To b : Print Using "####"; array(i); : Next i
+
+Sleep

Task/Sorting-algorithms-Patience-sort/XPL0/sorting-algorithms-patience-sort.xpl0

@@ -0,0 +1,33 @@
+def  N = 10, Inf = -1>>1;       \number of cards/items in Array
+int  Array, Pile(N, N+1);       \N piles with maximum size of N+1
+int  Inx(N+1);                  \index into each Pile to topmost card/item
+int  I, J, Card, Min, IMin;
+[Array:= [4, 65, 2, -31, 0, 99, 83, 782, 1, 0];
+for I:= 0 to N-1 do Pile(I, 0):= Inf;
+for I:= 0 to N-1 do Inx(I):= 0;
+\Step 1: Put cards into piles
+for I:= 0 to N-1 do                     \for each card in array
+    [Card:= Array(I);
+    J:= 0;                              \for each pile
+    loop    [if Pile(J, Inx(J)) >= Card then
+                [Inx(J):= Inx(J)+1;     \put card onto pile
+                    Pile(J, Inx(J)):= Card;
+                    quit;               \next card
+                    ];
+                J:= J+1;                \next pile
+            ];
+    ];
+\Step 2: N-way merge sort
+loop    [Min:= Inf;                     \search piles for smallest card
+        for I:= 0 to N-1 do             \for each pile
+            [Card:= Pile(I, Inx(I));    \get top card from pile
+            if Card <= Min then
+                [Min:= Card;  IMin:= I];
+            ];
+        if Min = Inf then quit;
+        Card:= Pile(IMin, Inx(IMin));
+        IntOut(0, Card);  Text(0, " "); \show smallest card
+        Inx(IMin):= Inx(IMin)-1;        \remove smallest card
+        ];
+CrLf(0);
+]