Data update

Task/Josephus-problem/Ada/josephus-problem.adb

@@ -0,0 +1,43 @@
+with Ada.Command_Line, Ada.Text_IO;
+
+procedure Josephus is
+
+   function Arg(Index, Default: Positive) return Natural is -- read Argument(Index)
+      (if Ada.Command_Line.Argument_Count >= Index
+         then Natural'Value(Ada.Command_Line.Argument(Index)) else Default);
+
+   Prisoners:  constant Positive := Arg(Index => 1, Default => 41);
+   Steps:      constant Positive := Arg(Index => 2, Default =>  3);
+   Survivors:  constant Positive := Arg(Index => 3, Default =>  1);
+   Print:               Boolean := (Arg(Index => 4, Default =>  1) = 1);
+
+   subtype Index_Type is Natural range 0 .. Prisoners-1;
+   Next: array(Index_Type) of Index_Type;
+   X: Index_Type := (Steps-2) mod Prisoners;
+
+begin
+   Ada.Text_IO.Put_Line
+     ("N =" & Positive'Image(Prisoners) & ",  K =" & Positive'Image(Steps) &
+        (if Survivors > 1 then ",  #survivors =" & Positive'Image(Survivors)
+        else ""));
+   for Index in Next'Range loop -- initialize Next
+      Next(Index) := (Index+1) mod Prisoners;
+   end loop;
+   if Print then
+      Ada.Text_IO.Put("Executed: ");
+   end if;
+   for Execution in reverse 1 .. Prisoners loop
+      if Execution = Survivors then
+         Ada.Text_IO.New_Line;
+         Ada.Text_IO.Put("Surviving: ");
+         Print := True;
+      end if;
+      if Print then
+         Ada.Text_IO.Put(Positive'Image(Next(X)));
+      end if;
+      Next(X) := Next(Next(X)); -- "delete" a prisoner
+      for Prisoner in 1 .. Steps-1 loop
+         X := Next(X);
+      end loop;
+   end loop;
+end Josephus;

Task/Josephus-problem/D/josephus-problem.d

@@ -11,7 +11,7 @@ string josephus(in int n, in int k) pure /*nothrow*/ @safe {
     int i;
     immutable(int)[] seq;
     while (!p.empty) {
-        i = (i + k - 1) % p.length;
+        i = (i + k - 1) % cast(int)p.length;
         seq ~= p.pop(i);
     }
 

Task/Josephus-problem/Emacs-Lisp/josephus-problem.el

@@ -0,0 +1,9 @@
+(defun jo (n k)
+  (if (= 1 n)
+      1
+    (1+ (% (+ (1- k)
+              (jo (1- n) k))
+           n))))
+
+(message "%d" (jo 50 2))
+(message "%d" (jo 60 3))

Task/Josephus-problem/Fortran/josephus-problem-2.f

@@ -0,0 +1,100 @@
+program josephus
+   implicit none
+
+   integer :: n, k, m, i, pq
+   integer, allocatable :: seq(:)
+   integer :: ios
+
+   ! --- Verify with the n=5, k=2 example from the problem ---
+   n = 5;  k = 2
+   allocate(seq(n))
+   call josephus_sequence(n, , k, seq)
+   write(*, '(a)') 'Verification: n=5, k=2'
+   write(*, '(2x,a)', advance='no') 'Kill order: '
+   do i = 1, n - 1
+      write(*, '(i0,a)', advance='no') seq(i), ' '
+   end do
+   write(*, '(a,i0)') '  survivor: #', seq(n)
+   deallocate(seq)
+
+   ! --- Classic Josephus: n=41, k=3 ---
+   n = 41;  k = 3
+   allocate(seq(n))
+   call josephus_sequence(n, k, seq)
+   write(*, '(/a)') 'Josephus problem: n=41, k=3'
+   write(*, '(2x,a,i0)') 'Josephus survived as prisoner #', seq(n)
+   write(*, '(2x,a)') 'Full killing sequence:'
+   do i = 1, n - 1
+      write(*, '(4x,a,i0,a,i0)') 'step ', i, ':  prisoner #', seq(i)
+   end do
+   deallocate(seq)
+
+   ! --- Interactive mode ---
+   write(*, '(/a)') 'Interactive: enter  n  k  m  (m = survivors; n=0 to quit)'
+   do
+      read(*, *, iostat=ios) n, k, m
+      if (ios /= 0 .or. n <= 0) exit
+      if (k <= 0 .or. m < 1 .or. m > n) then
+         write(*, '(2x,a)') 'Invalid input: need k>0, 1<=m<=n'
+         cycle
+      end if
+
+      allocate(seq(n))
+      call josephus_sequence(n, k, seq)
+
+      if (m == 1) then
+         write(*, '(2x,a,i0,a,i0,a,i0)') &
+            'n=', n, '  k=', k, ':  survivor is prisoner #', seq(n)
+      else
+         write(*, '(2x,a,i0,a,i0,a,i0,a)') &
+            'n=', n, '  k=', k, ':  ', m, ' survivors (in rescue order):'
+         do i = n - m + 1, n
+            write(*, '(4x,a,i0)') 'prisoner #', seq(i)
+         end do
+      end if
+
+      write(*, '(2x,a,i0,a)') 'Kill sequence (', n - m, ' killed):'
+      do i = 1, n - m
+         write(*, '(4x,a,i0,a,i0)') 'step ', i, ':  prisoner #', seq(i)
+      end do
+
+      write(*, '(2x,a)', advance='no') &
+         'Query position in sequence (0 to skip): '
+      read(*, *, iostat=ios) pq
+      if (ios == 0 .and. pq >= 1 .and. pq <= n) then
+         write(*, '(4x,a,i0,a,i0)') &
+            'Position ', pq, ' in sequence: prisoner #', seq(pq)
+      end if
+
+      deallocate(seq)
+   end do
+
+contains
+
+   ! Build the full Josephus sequence for n prisoners, step k.
+   ! killed(1) = first prisoner executed, killed(n) = sole survivor.
+   ! For m survivors, the freed prisoners are killed(n-m+1) .. killed(n).
+   subroutine josephus_sequence(n, k, killed)
+      integer, intent(in)  :: n, k
+      integer, intent(out) :: killed(n)
+      integer :: circle(n), alive, pos, i
+
+      do i = 1, n
+         circle(i) = i - 1     ! prisoners numbered 0 .. n-1
+      end do
+
+      alive = n
+      pos   = 1                ! 1-indexed position in the shrinking circle
+
+      do i = 1, n
+         ! Advance k-1 more steps from current pos (wrapping); that is the target
+         pos       = mod(pos + k - 2, alive) + 1
+         killed(i) = circle(pos)
+         ! Remove the killed prisoner by compacting the array
+         if (pos < alive) circle(pos:alive - 1) = circle(pos + 1:alive)
+         alive = alive - 1
+         if (alive > 0 .and. pos > alive) pos = 1
+      end do
+   end subroutine josephus_sequence
+
+end program josephus

Task/Josephus-problem/Julia/josephus-problem-1.jl

@@ -1,5 +1,5 @@
-using Memoize
-@memoize josephus(n::Integer, k::Integer, m::Integer=1) = n == m ? collect(0:m .- 1) : mod.(josephus(n - 1, k, m) + k, n)
+using Memoization
+@memoize josephus(n::Integer, k::Integer, m::Integer=1) = n == m ? collect(0:m .- 1) : mod.(josephus(n - 1, k, m) .+ k, n)
 
 @show josephus(41, 3)
 @show josephus(41, 3, 5)

Task/Josephus-problem/Julia/josephus-problem-2.jl

@@ -1,5 +1,5 @@
-function josephus(n::Integer, k::Integer, m::Integer=1)
-    p, i, seq = collect(0:n-1), 0, Vector{typeof(n)}(0)
+function josephus(n::T, k::T, m::T=one(T)) where T <: Integer
+    p, i, seq = collect(0:n-1), 0, [zero(T)]
     while length(p) > m
         i = (i + k - 1) % length(p)
         push!(seq, splice!(p, i + 1))

Task/Josephus-problem/Loglan82/josephus-problem.loglan82

@@ -0,0 +1,22 @@
+(* Josephus problem *)
+block
+var
+  k, m, n: integer;
+
+  unit Josephus: function (n, k, m: integer): integer;
+  var
+    a, j: integer;
+  begin
+    j := m;
+    for a := m + 1 to n do
+      j := (j + k) mod a
+    od;
+    result := j;
+  end Josephus;
+
+begin
+  n := 41;
+  k := 3;
+  m := 0;
+  writeln("N = ", n: 1, ". K = ", k: 1, ". Final survivor = ", Josephus(n, k, m): 1, ".");
+end;

Task/Josephus-problem/MoonRock/josephus-problem.moonrock

@@ -0,0 +1,22 @@
+' Josephus problem
+
+BEGIN DEF
+pointer word JosephusPtr~
+SUB CalcJosephus(N%, K%, M%, JosephusPtr~)
+
+BEGIN CODE
+N% = 41
+K% = 3
+M% = 0
+CALL CalcJosephus(N%, K%, M%, VARPTR(Josephus%))
+PRINT "N = " + N% + ", K = " + K% + ", Final survivor = " + Josephus% + "\n"
+END
+
+SUB CalcJosephus(N%, K%, M%, JosephusPtr~)
+[JosephusPtr~] = M%
+MPl1% = M% + 1
+FOR A% = Mpl1% TO N%
+  [JosephusPtr~] = [JosephusPtr~] + K%
+  [JosephusPtr~] = [JosephusPtr~] MOD A%
+NEXT
+END SUB

Task/Josephus-problem/Pascal-P/josephus-problem.pas

@@ -0,0 +1,23 @@
+program josephus(output);
+
+  (* Josephus problem *)
+var
+  n, k, m: integer;
+
+  function josephus(n, k, m: integer): integer;
+  var
+    a, j: integer;
+  begin
+    j := m;
+    for a := m + 1 to n do
+      j := (j + k) mod a;
+    josephus := j;
+  end;
+
+begin
+  n := 41;
+  k := 3;
+  m := 0;
+  writeln('N = ', n:1, ', K = ', k:1, ', Final survivor = ', josephus(n, k, m):1);
+  (* readln; *)
+end.

Task/Josephus-problem/Phix/josephus-problem.phix

@@ -16,7 +16,7 @@ function skipping(sequence prisoners, integer step, survivors=1)
 end function
 --?skipping({"Joe","Jack","William","John","James"},2,1) --> {"William"}
 
--- linked list - used by Arch64 Assembly, Ada, ARM Assembly, Common Lisp[2, probably], Fortran,
+-- linked list - used by Arch64 Assembly, Ada, ARM Assembly, Common Lisp[2, probably], Fortran(original),
 --                       JavaScript[1] (albeit dbl-lnk), Python[3].
 -- Method: like skipping, all prisoners stay where they are, but
 --         the executioner uses the links to speed things up a bit.
@@ -81,9 +81,9 @@ end function
 -- always using a loop and remove_all() - while not probihitively expensive, it may check lots of things for -1
 -- that the slicing won't.
 
--- contractalot - used by 11L, Arturo, AutoHotkey, C#, C++, Delphi, Frink, Formulae, Java (both), JavaScript[2],
---                        Julia[2], Kotlin, Lua, NanoQuery, Nim, Objeck, Oforth, Processing, Python[1], R[2],
---                        Rust, Seed7, Swift, VBScript, Vedit, VisualBasic.NET, XPL0, zkl.
+-- contractalot - used by 11L, Arturo, AutoHotkey, C#, C++, Delphi, Frink, Formulae, Fortran(alternative), Java (both),
+--                        JavaScript[2], Julia[2], Kotlin, Lua, NanoQuery, Nim, Objeck, Oforth, Processing, Python[1],
+--                        R[2], Rust, Seed7, Swift, VBScript, Vedit, VisualBasic.NET, XPL0, zkl.
 -- Method: executioner walks round and round, queue contracts after every kill.
 --         Often implemented as execute all prisoners then release last one killed.
 function contractalot(integer n, integer k, s)

Task/Josephus-problem/PowerShell/josephus-problem-1.ps1

@@ -0,0 +1,20 @@
+function Get-JosephusPrisoners ( [int]$N, [int]$K )
+    {
+    #  Just for convenience
+    $End = $N - 1
+
+    #  Create circle of prisoners
+    $Prisoners = New-Object System.Collections.ArrayList ( , (0..$End) )
+
+    #  For each starting point of the reducing circle...
+    ForEach ( $Start in 0..($End - 1) )
+        {
+        #  We subtract one from K for the one we advanced by incrementing $Start
+        #  Then take K modulus the length of the remaining circle
+        $RoundK = ( $K - 1 ) % ( $End - $Start + 1 )
+
+        #  Rotate the remaining prisoners K places around the remaining circle
+        $Prisoners.SetRange( $Start, $Prisoners[ $Start..$End ][ ( $RoundK + $Start - $End - 1 )..( $RoundK - 1 ) ] )
+        }
+    return $Prisoners
+    }

Task/Josephus-problem/PowerShell/josephus-problem-2.ps1

@@ -0,0 +1,12 @@
+#  Get the prisoner order for a circle of 41 prisoners, selecting every third
+$Prisoners = Get-JosephusPrisoners -N 41 -K 3
+
+#  Display the prisoner order
+$Prisoners -join " "
+
+#  Display the last remaining prisoner
+"Last prisoner remmaining: " + $Prisoners[-1]
+
+#  Display the last three remaining prisoners
+$S = 3
+"Last $S remaining: " + $Prisoners[-$S..-1]

Task/Josephus-problem/Python/josephus-problem-2.py

@@ -1,6 +1,6 @@
->>>def josephus(n, k):
+>>> def josephus(n, k):
         r = 0
-        for i in xrange(1, n+1):
+        for i in range(1, n+1):
             r = (r+k)%i
         return 'Survivor: %d' %r
 

Task/Josephus-problem/Python/josephus-problem-3.py

@@ -13,7 +13,5 @@ def josephus(n, k):
     return v
 
 josephus(10, 2)
-[1, 3, 5, 7, 9, 2, 6, 0, 8, 4]
 
 josephus(41, 3)[-1]
-30

Task/Josephus-problem/Python/josephus-problem-4.py

@@ -1,6 +1,6 @@
 from itertools import compress, cycle
-def josephus(prisoner, kill, surviver):
-    p = range(prisoner)
+def josephus(prisoner, kill, survivor):
+    p = list(range(prisoner))
     k = [0] * kill
     k[kill-1] = 1
     s = [1] * kill
@@ -10,7 +10,7 @@ def josephus(prisoner, kill, surviver):
     queue = compress(queue, cycle(s))
     try:
         while True:
-            p.append(queue.next())
+            p.append(next(queue))
     except StopIteration:
         pass
 
@@ -18,16 +18,13 @@ def josephus(prisoner, kill, surviver):
     killed = compress(p, cycle(k))
     try:
         while True:
-            kil.append(killed.next())
+            kil.append(next(killed))
     except StopIteration:
         pass
 
-    print 'The surviver is: ', kil[-surviver:]
-    print 'The kill sequence is ', kil[:prisoner-surviver]
+    print('The survivor is: ', kil[-survivor:])
+    print('The kill sequence is ', kil[:prisoner-survivor])
 
-josephus(41,3,2)
-The surviver is:  [15, 30]
-The kill sequence is  [2, 5, 8, 11, 14, 17, 20, 23, 26, 29, 32, 35, 38, 0, 4, 9, 13, 18, 22, 27, 31, 36, 40, 6, 12, 19, 25, 33, 39, 7, 16, 28, 37, 10, 24, 1, 21, 3, 34]
-josephus(5,2,1)
-The surviver is:  [2]
-The kill sequence is  [1, 3, 0, 4]
+josephus(41, 3, 2)
+
+josephus(5, 2, 1)

Task/Josephus-problem/Rebol/josephus-problem-1.rebol

@@ -0,0 +1,13 @@
+Rebol []
+
+execute: func [death-list [block!] kill [integer!]] [
+    assert [not empty? death-list]
+    until [
+        loop kill - 1 [append death-list take death-list]
+        (1 == length? remove death-list)
+    ]
+]
+
+prisoner: [] for n 0 40 1 [append prisoner n]
+execute prisoner 3
+print ["Prisoner" prisoner "survived"]

Task/Josephus-problem/Rebol/josephus-problem-2.rebol

@@ -0,0 +1,3 @@
+for-the-chop: [Joe Jack William Averell Rantanplan]
+execute for-the-chop 2
+print [for-the-chop "survived"]

Task/Josephus-problem/V-(Vlang)/josephus-problem.v

@@ -1,7 +1,7 @@
 // basic task fntion
 fn final_survivor(n int, kk int) int {
     // argument validation omitted
-    mut circle := []int{len: n, init: it}
+    mut circle := []int{len: n, init: index}
     k := kk-1
     mut ex_pos := 0
     for circle.len > 1 {
@@ -14,7 +14,7 @@ fn final_survivor(n int, kk int) int {
 // extra
 fn position(n int, kk int, p int) int {
     // argument validation omitted
-    mut circle := []int{len: n, init: it}
+    mut circle := []int{len: n, init: index}
     k := kk-1
 	mut pos := p
     mut ex_pos := 0

Task/Josephus-problem/VBScript/josephus-problem.vbs

@@ -0,0 +1,32 @@
+Function josephus(n,k,s)
+	Set prisoner = CreateObject("System.Collections.ArrayList")
+	For i = 0 To n - 1
+		prisoner.Add(i)
+	Next
+	index = -1
+	Do Until prisoner.Count = s
+		step_count = 0
+		Do Until step_count = k
+			If index+1 <= prisoner.Count-1 Then
+				index = index+1
+			Else
+				index = (index+1)-(prisoner.Count)
+			End If
+			step_count = step_count+1
+		Loop
+		prisoner.RemoveAt(index)
+		index = index-1
+	Loop
+	For j = 0 To prisoner.Count-1
+		If j < prisoner.Count-1 Then
+			josephus = josephus & prisoner(j) & ","
+		Else
+			josephus = josephus & prisoner(j)
+		End If
+	Next
+End Function
+
+'testing the function
+WScript.StdOut.WriteLine josephus(5,2,1)
+WScript.StdOut.WriteLine josephus(41,3,1)
+WScript.StdOut.WriteLine josephus(41,3,3)