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

June 2018 Update

Browse source
This commit is contained in:
Ingy döt Net 2018-06-22 20:57:24 +00:00
parent ba8067c3b7
commit 22f33d4004
5278 changed files with 84726 additions and 14379 deletions
Download patch file Download diff file Expand all files Collapse all files

29
Task/Ethiopian-multiplication/BASIC/ethiopian-multiplication-10.basic Normal file
View file

@ -0,0 +1,29 @@
!RosettaCode: Ethiopian Multiplication
! True BASIC v6.007
PROGRAM EthiopianMultiplication
DECLARE DEF FNdouble
DECLARE DEF FNhalve
DECLARE DEF FNeven
LET x = 17
LET y = 34
DO
IF FNeven(x) = 0 THEN
LET p = p + y
PRINT x,y
ELSE
PRINT x," ---"
END IF
LET x = FNhalve(x)
LET y = FNdouble(y)
LOOP UNTIL x = 0
PRINT " ", " ==="
PRINT " ", p
GET KEY done
DEF FNdouble(A) = A * 2
DEF FNhalve(A) = INT(A / 2)
DEF FNeven(A) = MOD(A+1,2)
END

51
Task/Ethiopian-multiplication/BASIC/ethiopian-multiplication-6.basic
View file

@ -1,33 +1,18 @@
Procedure isEven(x)
ProcedureReturn (x & 1) ! 1
EndProcedure
Procedure halveValue(x)
ProcedureReturn x / 2
EndProcedure
Procedure doubleValue(x)
ProcedureReturn x << 1
EndProcedure
Procedure EthiopianMultiply(x, y)
Protected sum
Print("Ethiopian multiplication of " + Str(x) + " and " + Str(y) + " ... ")
Repeat
If Not isEven(x)
sum + y
EndIf
x = halveValue(x)
y = doubleValue(y)
Until x < 1
PrintN(" equals " + Str(sum))
ProcedureReturn sum
EndProcedure
If OpenConsole()
EthiopianMultiply(17,34)
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
Input()
CloseConsole()
EndIf
x = 17
y = 34
tot = 0
While x >= 1
TextWindow.Write(x)
TextWindow.CursorLeft = 10
If Math.Remainder(x + 1, 2) = 0 Then
tot = tot + y
TextWindow.WriteLine(y)
Else
TextWindow.WriteLine("")
EndIf
x = Math.Floor(x / 2)
y = 2 * y
EndWhile
TextWindow.Write("=")
TextWindow.CursorLeft = 10
TextWindow.WriteLine(tot)

11
Task/Ethiopian-multiplication/BASIC/ethiopian-multiplication-7.basic
View file

@ -11,26 +11,21 @@ Procedure doubleValue(x)
EndProcedure
Procedure EthiopianMultiply(x, y)
Protected sum, sign = x
Print("Ethiopian multiplication of " + Str(x) + " and " + Str(y) + " ...")
Protected sum
Print("Ethiopian multiplication of " + Str(x) + " and " + Str(y) + " ... ")
Repeat
If Not isEven(x)
sum + y
EndIf
x = halveValue(x)
y = doubleValue(y)
Until x = 0
If sign < 0 : sum * -1: EndIf
Until x < 1
PrintN(" equals " + Str(sum))
ProcedureReturn sum
EndProcedure
If OpenConsole()
EthiopianMultiply(17,34)
EthiopianMultiply(-17,34)
EthiopianMultiply(-17,-34)
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
Input()

76
Task/Ethiopian-multiplication/BASIC/ethiopian-multiplication-8.basic
View file

@ -1,38 +1,38 @@
10 LET HALVE=320
20 LET DOUBLE=340
30 LET EVEN=360
40 DIM L(20)
50 DIM R(20)
60 INPUT L(1)
70 INPUT R(1)
80 LET I=1
90 PRINT L(1),R(1)
100 IF L(I)=1 THEN GOTO 200
110 LET I=I+1
120 IF I>20 THEN STOP
130 LET X=L(I-1)
140 GOSUB HALVE
150 LET L(I)=Y
160 LET X=R(I-1)
170 GOSUB DOUBLE
180 LET R(I)=Y
190 GOTO 90
200 FOR K=1 TO I
210 LET X=L(K)
220 GOSUB EVEN
230 IF NOT Y THEN GOTO 260
240 LET R(K)=0
250 PRINT AT K-1,16;" "
260 NEXT K
270 LET A=0
280 FOR K=1 TO I
290 LET A=A+R(K)
300 NEXT K
310 GOTO 380
320 LET Y=INT (X/2)
330 RETURN
340 LET Y=X*2
350 RETURN
360 LET Y=X/2=INT (X/2)
370 RETURN
380 PRINT AT I+1,16;A
Procedure isEven(x)
ProcedureReturn (x & 1) ! 1
EndProcedure
Procedure halveValue(x)
ProcedureReturn x / 2
EndProcedure
Procedure doubleValue(x)
ProcedureReturn x << 1
EndProcedure
Procedure EthiopianMultiply(x, y)
Protected sum, sign = x
Print("Ethiopian multiplication of " + Str(x) + " and " + Str(y) + " ...")
Repeat
If Not isEven(x)
sum + y
EndIf
x = halveValue(x)
y = doubleValue(y)
Until x = 0
If sign < 0 : sum * -1: EndIf
PrintN(" equals " + Str(sum))
ProcedureReturn sum
EndProcedure
If OpenConsole()
EthiopianMultiply(17,34)
EthiopianMultiply(-17,34)
EthiopianMultiply(-17,-34)
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
Input()
CloseConsole()
EndIf

67
Task/Ethiopian-multiplication/BASIC/ethiopian-multiplication-9.basic
View file

@ -1,29 +1,38 @@
!RosettaCode: Ethiopian Multiplication
! True BASIC v6.007
PROGRAM EthiopianMultiplication
DECLARE DEF FNdouble
DECLARE DEF FNhalve
DECLARE DEF FNeven
LET x = 17
LET y = 34
DO
IF FNeven(x) = 0 THEN
LET p = p + y
PRINT x,y
ELSE
PRINT x," ---"
END IF
LET x = FNhalve(x)
LET y = FNdouble(y)
LOOP UNTIL x = 0
PRINT " ", " ==="
PRINT " ", p
GET KEY done
DEF FNdouble(A) = A * 2
DEF FNhalve(A) = INT(A / 2)
DEF FNeven(A) = MOD(A+1,2)
END
10 LET HALVE=320
20 LET DOUBLE=340
30 LET EVEN=360
40 DIM L(20)
50 DIM R(20)
60 INPUT L(1)
70 INPUT R(1)
80 LET I=1
90 PRINT L(1),R(1)
100 IF L(I)=1 THEN GOTO 200
110 LET I=I+1
120 IF I>20 THEN STOP
130 LET X=L(I-1)
140 GOSUB HALVE
150 LET L(I)=Y
160 LET X=R(I-1)
170 GOSUB DOUBLE
180 LET R(I)=Y
190 GOTO 90
200 FOR K=1 TO I
210 LET X=L(K)
220 GOSUB EVEN
230 IF NOT Y THEN GOTO 260
240 LET R(K)=0
250 PRINT AT K-1,16;" "
260 NEXT K
270 LET A=0
280 FOR K=1 TO I
290 LET A=A+R(K)
300 NEXT K
310 GOTO 380
320 LET Y=INT (X/2)
330 RETURN
340 LET Y=X*2
350 RETURN
360 LET Y=X/2=INT (X/2)
370 RETURN
380 PRINT AT I+1,16;A

11
Task/Ethiopian-multiplication/Julia/ethiopian-multiplication-1.julia
View file

@ -1,8 +1,3 @@
# bit shifting, equivalent to div(x, 2)
halve(x::Int) = x >> 1
# preserves the type
double(x::Int) = 2*x
# could just use iseven(x), but that feels like cheating
even(x::Int) = (mod(x, 2) == 0 ? true : false)
halve(x::Integer) = x >> one(x)
double(x::Integer) = Int8(2) * x
even(x::Integer) = x & 1 != 1

10
Task/Ethiopian-multiplication/Julia/ethiopian-multiplication-2.julia
View file

@ -1,9 +1,11 @@
function ethopian_multiplication(a::Int, b::Int)
res = 0
function ethmult(a::Integer, b::Integer)
r = 0
while a > 0
res += even(a) ? 0 : b
r += b * !even(a)
a = halve(a)
b = double(b)
end
return res
return r
end
@show ethmult(17, 34)

6
Task/Ethiopian-multiplication/Julia/ethiopian-multiplication-3.julia
View file

@ -1,9 +1,11 @@
function ethopian_multiplication_arr(a::Int, b::Int)
function ethmult2(a::Integer, b::Integer)
A = [a]
B = [b]
while A[end] > 1
push!(A, halve(A[end]))
push!(B, double(B[end]))
end
return sum(B[!map(even, A)])
return sum(B[map(!even, A)])
end
@show ethmult2(17, 34)

54
Task/Ethiopian-multiplication/Limbo/ethiopian-multiplication.limbo Normal file
View file

@ -0,0 +1,54 @@
implement Ethiopian;
include "sys.m";
sys: Sys;
print: import sys;
include "draw.m";
draw: Draw;
Ethiopian : module
{
init : fn(ctxt : ref Draw->Context, args : list of string);
};
init (ctxt: ref Draw->Context, args: list of string)
{
sys = load Sys Sys->PATH;
print("\n%d\n", ethiopian(17, 34, 0));
print("\n%d\n", ethiopian(99, 99, 1));
}
halve(n: int): int
{
return (n /2);
}
double(n: int): int
{
return (n * 2);
}
iseven(n: int): int
{
return ((n%2) == 0);
}
ethiopian(a: int, b: int, tutor: int): int
{
product := 0;
if (tutor)
print("\nmultiplying %d x %d", a, b);
while (a >= 1) {
if (!(iseven(a))) {
if (tutor)
print("\n%3d %d", a, b);
product += b;
} else
if (tutor)
print("\n%3d ----", a);
a = halve(a);
b = double(b);
}
return product;
}

44
Task/Ethiopian-multiplication/Modula-2/ethiopian-multiplication.mod2 Normal file
View file

@ -0,0 +1,44 @@
MODULE EthiopianMultiplication;
FROM SWholeIO IMPORT
WriteCard;
FROM STextIO IMPORT
WriteString, WriteLn;
PROCEDURE Halve(VAR A: CARDINAL);
BEGIN
A := A / 2;
END Halve;
PROCEDURE Double(VAR A: CARDINAL);
BEGIN
A := 2 * A;
END Double;
PROCEDURE IsEven(A: CARDINAL): BOOLEAN;
BEGIN
RETURN (X + 1) REM 2 = 0;
END IsEven;
VAR
X, Y, Tot: CARDINAL;
BEGIN
X := 17;
Y := 34;
Tot := 0;
WHILE X >= 1 DO
WriteCard(X, 9);
WriteString(" ");
IF IsEven(X) THEN
INC(Tot, Y);
WriteCard(Y, 9)
END;
WriteLn;
Halve(X);
Double(Y);
END;
WriteString("= ");
WriteCard(Tot, 9);
WriteLn;
END EthiopianMultiplication.

11
Task/Ethiopian-multiplication/VBA/ethiopian-multiplication-1.vba Normal file
View file

@ -0,0 +1,11 @@
Private Function lngHalve(Nb As Long) As Long
lngHalve = Nb / 2
End Function
Private Function lngDouble(Nb As Long) As Long
lngDouble = Nb * 2
End Function
Private Function IsEven(Nb As Long) As Boolean
IsEven = (Nb Mod 2 = 0)
End Function

30
Task/Ethiopian-multiplication/VBA/ethiopian-multiplication-2.vba Normal file
View file

@ -0,0 +1,30 @@
Private Function Ethiopian_Multiplication_Non_Optimized(First As Long, Second As Long) As Long
Dim Left_Hand_Column As New Collection, Right_Hand_Column As New Collection, i As Long, temp As Long
'Take two numbers to be multiplied and write them down at the top of two columns.
Left_Hand_Column.Add First, CStr(First)
Right_Hand_Column.Add Second, CStr(Second)
'In the left-hand column repeatedly halve the last number, discarding any remainders,
'and write the result below the last in the same column, until you write a value of 1.
Do
First = lngHalve(First)
Left_Hand_Column.Add First, CStr(First)
Loop While First > 1
'In the right-hand column repeatedly double the last number and write the result below.
'stop when you add a result in the same row as where the left hand column shows 1.
For i = 2 To Left_Hand_Column.Count
Second = lngDouble(Second)
Right_Hand_Column.Add Second, CStr(Second)
Next
'Examine the table produced and discard any row where the value in the left column is even.
For i = Left_Hand_Column.Count To 1 Step -1
If IsEven(Left_Hand_Column(i)) Then Right_Hand_Column.Remove CStr(Right_Hand_Column(i))
Next
'Sum the values in the right-hand column that remain to produce the result of multiplying
'the original two numbers together
For i = 1 To Right_Hand_Column.Count
temp = temp + Right_Hand_Column(i)
Next
Ethiopian_Multiplication_Non_Optimized = temp
End Function

7
Task/Ethiopian-multiplication/VBA/ethiopian-multiplication-3.vba Normal file
View file

@ -0,0 +1,7 @@
Private Function Ethiopian_Multiplication(First As Long, Second As Long) As Long
Do
If Not IsEven(First) Then Mult_Eth = Mult_Eth + Second
First = lngHalve(First)
Second = lngDouble(Second)
Loop While First >= 1
End Function

7
Task/Ethiopian-multiplication/VBA/ethiopian-multiplication-4.vba Normal file
View file

@ -0,0 +1,7 @@
Sub Main_Ethiopian()
Dim result As Long
result = Ethiopian_Multiplication(17, 34)
' or :
'result = Ethiopian_Multiplication_Non_Optimized(17, 34)
Debug.Print result
End Sub