aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

September 2017 Update

Browse source
This commit is contained in:
Ingy döt Net 2017-09-23 10:01:46 +02:00
parent bba7bfd280
commit ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
Download patch file Download diff file Expand all files Collapse all files

82
Task/Josephus-problem/360-Assembly/josephus-problem.360 Normal file
View file

@ -0,0 +1,82 @@
* Josephus problem 10/02/2017
JOSEPH CSECT
USING JOSEPH,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
STM R14,R12,12(R13) prolog
ST R13,4(R15) " <-
ST R15,8(R13) " ->
LR R13,R15 " addressability
LA R7,1 m=1
DO WHILE=(C,R7,LE,=A(NPROB)) do m=1 to nprob
LR R1,R7 m
MH R1,=H'6' *6
LH R2,PROB-6(R1)
ST R2,N n=prob(m,1)
LH R2,PROB-4(R1)
ST R2,W w=prob(m,2)
LH R2,PROB-2(R1)
ST R2,S s=prob(m,3)
MVC PG,=CL80'josephus' init buffer
L R1,N n
XDECO R1,DEC edit
MVC PG+8(4),DEC+8 output
L R1,W w
XDECO R1,DEC edit
MVC PG+12(4),DEC+8 output
L R1,S s
XDECO R1,DEC edit
MVC PG+16(4),DEC+8 output
XPRNT PG,L'PG print buffer
MVI DEAD,X'00' dead(1)='0'B;
MVC DEAD+1(255),DEAD dead(*)='0'B;
L R11,N nx=n
L R8,=F'-1' p=-1
DO UNTIL=(C,R11,EQ,S) do until n=s
SR R9,R9 found=0
DO UNTIL=(C,R9,EQ,W) do until found=w
LA R8,1(R8) p=p+1
IF C,R8,EQ,N THEN if p=nn then
SR R8,R8 p=0
ENDIF , end if
LA R2,DEAD(R8) @dead(p+1)
IF CLI,0(R2),EQ,X'00' THEN if not dead(p+1) then
LA R9,1(R9) found=found+1
ENDIF , end if
ENDDO , end do
LA R2,DEAD(R8) @dead(p+1)
MVI 0(R2),X'01' dead(p+1)='1'B
BCTR R11,0 nx=nx-1
ENDDO , end do
MVC PG,=CL80' ' clear buffer
LA R10,PG ipg=0
L R9,N nn
BCTR R9,0 nn-1
SR R6,R6 i=0
DO WHILE=(CR,R6,LE,R9) do i=0 to nn-1
LA R2,DEAD(R6) @dead(i+1)
IF CLI,0(R2),EQ,X'00' THEN if not dead(i+1) then
XDECO R6,DEC edit i
MVC 0(4,R10),DEC+8 output
LA R10,4(R10) ipg=ipg+4
ENDIF , end if
LA R6,1(R6) i=i+1
ENDDO , end do
XPRNT PG,L'PG print buffer
LA R7,1(R7) m=m+1
ENDDO , end do
L R13,4(0,R13) epilog
LM R14,R12,12(R13) " restore
XR R15,R15 " rc=0
BR R14 exit
PROB DC H'41',H'3',H'1' round 1
DC H'41',H'3',H'3' round 2
NPROB EQU (*-PROB)/6 number of rounds
N DS F n number of prisoners
W DS F w killing count
S DS F s number of prisoners to survive
PG DS CL80 buffer
DEC DS CL12 temp for xdeco
DEAD DS 256X n max
YREGS
END JOSEPH

19
Task/Josephus-problem/Friendly-interactive-shell/josephus-problem-1.fish Normal file
View file

@ -0,0 +1,19 @@
function execute
# If the list is empty, don't do anything.
test (count $argv) -ge 2; or return
# If the list has only one element, return it
if test (count $argv) -eq 2
echo $argv[2]
return
end
# Rotate prisoners
for i in (seq 2 $argv[1])
set argv $argv[1 3..-1 2]
end
# Mention killed prisoner
echo $argv[2]
# Kill rest recursively
execute $argv[1 3..-1]
end
echo Prisoner (execute 3 (seq 0 40))[-1] survived.

1
Task/Josephus-problem/Friendly-interactive-shell/josephus-problem-2.fish Normal file
View file

@ -0,0 +1 @@
echo Prisoners (execute 3 (seq 0 40))[-3..-1] survived.

1
Task/Josephus-problem/Friendly-interactive-shell/josephus-problem-3.fish Normal file
View file

@ -0,0 +1 @@
echo Prisoner (execute 2 Joe Jack William Averell Rantanplan)[-1] survived.

17
Task/Josephus-problem/Haskell/josephus-problem-2.hs
View file

@ -1,11 +1,16 @@
jseq n k = f n [1 .. n] where
jseq :: Int -> Int -> [Int]
jseq n k = f n [1 .. n]
where
f 0 _ = []
f m s = x:f (m-1) (right ++ left) where
(left,x:right) = splitAt ((k-1) `mod` m) s
f m s = x : f (m - 1) (right ++ left)
where
(left, x:right) = splitAt (mod (k - 1) m) s
-- the final survivor is ((k + ...((k + ((k + 0)`mod` 1)) `mod` 2) ... ) `mod` n)
jos n k = 1 + foldl (\x->((k+x)`mod`)) 0 [2..n]
jos :: Int -> Int -> Int
jos n k = 1 + foldl (mod . (k +)) 0 [2 .. n]
main :: IO ()
main = do
print $ jseq 41 3
print $ jos 10000 100
print $ jseq 41 3
print $ jos 10000 100

0
Task/Josephus-problem/jq/josephus-problem-1.jq → Task/Josephus-problem/Jq/josephus-problem-1.jq
View file

0
Task/Josephus-problem/jq/josephus-problem-2.jq → Task/Josephus-problem/Jq/josephus-problem-2.jq
View file

33
Task/Josephus-problem/Kotlin/josephus-problem.kotlin Normal file
View file

@ -0,0 +1,33 @@
// version 1.1.3
fun josephus(n: Int, k: Int, m: Int): Pair<List<Int>, List<Int>> {
require(k > 0 && m > 0 && n > k && n > m)
val killed = mutableListOf<Int>()
val survived = MutableList(n) { it }
var start = k - 1
outer@ while (true) {
val end = survived.size - 1
var i = start
var deleted = 0
while (i <= end) {
killed.add(survived.removeAt(i - deleted))
if (survived.size == m) break@outer
deleted++
i += k
}
start = i - end - 1
}
return Pair(survived, killed)
}
fun main(args: Array<String>) {
val triples = listOf(Triple(5, 2, 1), Triple(41, 3, 1), Triple(41, 3, 3))
for (triple in triples) {
val(n, k, m) = triple
println("Prisoners = $n, Step = $m, Survivors = $m")
val (survived, killed) = josephus(n, k, m)
println("Survived : $survived")
println("Kill order : $killed")
println()
}
}

20
Task/Josephus-problem/Phix/josephus-problem.phix Normal file
View file

@ -0,0 +1,20 @@
function Josephus(sequence prisoners, integer step, survivors)
integer n = length(prisoners), nn = n
integer p = 0
while n>survivors do
integer found = 0
while found!=step do
p = iff(p=nn?1:p+1)
found += prisoners[p]!=-1
end while
-- (if you want a kill list, build it here!)
prisoners[p] = -1
n -= 1
end while
return remove_all(-1,prisoners)
end function
?Josephus(tagset(5),2,1)
?Josephus(tagset(41),3,1)
?Josephus(tagset(41),3,3)
?Josephus({"Joe","Jack","William","John","James"},2,1)

1
Task/Josephus-problem/PureBasic/josephus-problem.purebasic
View file

@ -1,4 +1,3 @@
Define.i
NewList prisoners.i()
Procedure f2l(List p.i())

34
Task/Josephus-problem/REXX/josephus-problem-2.rexx
View file

@ -1,26 +1,24 @@
/*REXX program solves Josephus problem: N men standing in a circle, every Kth kilt.*/
/*N=men, K=kilt, Z=start, R=remaining. */
parse arg N K Z R . /*obtain optional arguments from the CL*/
if N=='' | N=="," then N = 41 /*Not specified? Then use the default.*/
if K=='' | K=="," then K = 3 /* " " " " " " */
if Z=='' | Z=="," then Z = 0 /* " " " " " " */
if R=='' | R=="," then R = 1 /* " " " " " " */
$=; x=; do pop=Z for N; $=$ pop; end /*pop*/ /*populate prisoner's circle (with a #)*/
c=0 /*initial prisoner count─off number. */
do remove=0 by 0; p=words($) /*keep removing until R are remaining*/
c=c+K /*bump the prisoner count-off by K. */
if c>p then do /* [↓] remove (kill) some prisoner(s)*/
do j=1 for words(x); $=delword($, word(x, j) + 1 - j, 1)
if words($)==R then leave remove /*is the slaying done?*/
end /*j*/
c=(c//p) // words($); x= /*adjust prisoner count-off and circle.*/
end
if c\==0 then x=x c /*the list of prisoners to be removed. */
end /*remove*/ /*remove 'til R prisoners are left.*/
if N=='' | N=="," then N= 41 /* men not specified? Use default.*/
if K=='' | K=="," then K= 3 /* kilt " " " " */
if Z=='' | Z=="," then Z= 0 /* start " " " " */
if R=='' | R=="," then R= 1 /*remaining " " " " */
$=; do i=Z for N; $=$ i; end /*i*/ /*populate prisoner's circle (with a #)*/
x= /*the list of prisoners to be removed. */
do c=k by k; p=words($) /*keep removing until R are remaining*/
if c>p then do /* [↓] remove (kill) some prisoner(s)*/
do j=1 for words(x); $=delword($, word(x, j) + 1 - j, 1)
if words($)==R then leave c /*The slaying finished? (R people left)*/
end /*j*/
c=(c//p) // words($); x= /*adjust prisoner count-off and circle.*/
end
if c\==0 then x=x c /*the list of prisoners to be removed. */
end /*remove*/ /*remove 'til R prisoners are left.*/
say 'removing every ' th(K) " prisoner out of " N ' (starting at' Z") with ",
R ' survivor's(R)", leaving prisoner"s(R)':' $
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
s: if arg(1)==1 then return arg(3); return word( arg(2) 's', 1)
s: if arg(1)==1 then return arg(3); return word( arg(2) 's', 1) /*plurals*/
th: y=arg(1); return y || word('th st nd rd', 1+ y // 10 * (y//100%10\==1) * (y//10<4))

11
Task/Josephus-problem/Ring/josephus-problem.ring Normal file
View file

@ -0,0 +1,11 @@
n = 41
k=3
see "n =" + n + " k = " + k + " final survivor = " + josephus(n, k, 0) + nl
func josephus (n, k, m)
lm = m
for a = m+1 to n
lm = (lm+k) % a
next
josephus = lm
return josephus

17
Task/Josephus-problem/Ruby/josephus-problem.rb
View file

@ -1,13 +1,6 @@
def main
n = (ARGV[0] || 41).to_i
k = (ARGV[1] || 3).to_i
puts josephus(n,k)
end
n = (ARGV[0] || 41).to_i
k = (ARGV[1] || 3).to_i
def josephus(n, k)
prisoners = (0...n).to_a
prisoners.rotate!(k-1).shift while prisoners.length > 1
return prisoners.first
end
main
prisoners = (0...n).to_a
prisoners.rotate!(k-1).shift while prisoners.length > 1
puts prisoners.first

8
Task/Josephus-problem/SequenceL/josephus-problem.sequencel Normal file
View file

@ -0,0 +1,8 @@
main := josephus(41, 3);
josephus(n, k) := josephusHelper(n, k, 1, 0);
josephusHelper(n, k, i, r) :=
r when i > n
else
josephusHelper(n, k, i + 1, (r + k) mod i);

9
Task/Josephus-problem/Zkl/josephus-problem-1.zkl Normal file
View file

@ -0,0 +1,9 @@
fcn j(n,k){
reg p=[0..n-1].walk().copy(), i=0, seq=L();
while(p){
i=(i+k-1)%p.len();
seq.append(p.pop(i));
}
"Prisoner killing order: %s.\nSurvivor: %d"
.fmt(seq[0,-1].concat(","),seq[-1]);
}

9
Task/Josephus-problem/Zkl/josephus-problem-2.zkl Normal file
View file

@ -0,0 +1,9 @@
fcn j2(n,k,m){
reg p=[0..n-1].walk().copy(), i=0, seq=L();
while(p.len()>m){
i=(i+k-1)%p.len();
seq.append(p.pop(i));
}
"Prisoner killing order: %s.\nSurvivors: [%s]"
.fmt(seq.concat(","),p.concat(","))
}