Ethiopian multiplication: Difference between revisions
→{{header|Seed7}}: Incorrect. Examples should have separate functions for doubling, halving, and checking if a number is even. |
Added PascalABC.NET |
||
(531 intermediate revisions by more than 100 users not shown) | |||
Line 1: | Line 1: | ||
{{task|Arithmetic operations}} |
{{task|Arithmetic operations}} |
||
Ethiopian multiplication is a method of multiplying integers using only addition, doubling, and halving. |
|||
'''Method:'''<br> |
|||
'''Method:''' <br> |
|||
# Take two numbers to be multiplied and write them down at the top of two columns. |
# Take two numbers to be multiplied and write them down at the top of two columns. |
||
# 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. |
# 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. |
||
Line 9: | Line 10: | ||
# Sum the values in the right-hand column that remain to produce the result of multiplying the original two numbers together |
# Sum the values in the right-hand column that remain to produce the result of multiplying the original two numbers together |
||
<br> |
|||
'''For example:''' 17 × 34 |
|||
'''For example:''' 17 × 34 |
|||
17 34 |
17 34 |
||
Halving the first column: |
Halving the first column: |
||
Line 25: | Line 27: | ||
Strike-out rows whose first cell is even: |
Strike-out rows whose first cell is even: |
||
17 34 |
17 34 |
||
8 |
8 <strike>68</strike> |
||
4 |
4 <strike>136</strike> |
||
2 |
2 <strike>272</strike> |
||
1 544 |
1 544 |
||
Sum the remaining numbers in the right-hand column: |
Sum the remaining numbers in the right-hand column: |
||
Line 39: | Line 41: | ||
So 17 multiplied by 34, by the Ethiopian method is 578. |
So 17 multiplied by 34, by the Ethiopian method is 578. |
||
The task is to '''define three functions'''/methods/procedures/subroutines: |
|||
;Task: |
|||
The task is to '''define three named functions'''/methods/procedures/subroutines: |
|||
# one to '''halve an integer''', |
# one to '''halve an integer''', |
||
# one to '''double an integer''', and |
# one to '''double an integer''', and |
||
# one to '''state if an integer is even'''. |
# one to '''state if an integer is even'''. |
||
<br> |
|||
Use these functions to '''create a function that does Ethiopian multiplication'''. |
Use these functions to '''create a function that does Ethiopian multiplication'''. |
||
;Related tasks: |
|||
'''References''' |
|||
* [[Egyptian_division|Egyptian division]] |
|||
;References: |
|||
*[https://www.bbc.co.uk/programmes/p00zjz5f Ethiopian multiplication explained] (BBC Video clip) |
|||
<!-- *[http://www.bbc.co.uk/learningzone/clips/ethiopian-multiplication-explained/11232.html Ethiopian multiplication explained] (Video) --> |
|||
*[http://www.youtube.com/watch?v=Nc4yrFXw20Q A Night Of Numbers - Go Forth And Multiply] (Video) |
*[http://www.youtube.com/watch?v=Nc4yrFXw20Q A Night Of Numbers - Go Forth And Multiply] (Video) |
||
*[http://www.ncetm.org.uk/blogs/3064 Ethiopian multiplication] |
<!-- *[http://www.ncetm.org.uk/blogs/3064 Ethiopian multiplication] --> |
||
*[http://www.bbc.co.uk/dna/h2g2/A22808126 Russian Peasant Multiplication] |
*[http://www.bbc.co.uk/dna/h2g2/A22808126 Russian Peasant Multiplication] |
||
*[http://thedailywtf.com/Articles/Programming-Praxis-Russian-Peasant-Multiplication.aspx Programming Praxis: Russian Peasant Multiplication] |
*[http://thedailywtf.com/Articles/Programming-Praxis-Russian-Peasant-Multiplication.aspx Programming Praxis: Russian Peasant Multiplication] |
||
<br><br> |
|||
=={{header|11l}}== |
|||
{{trans|Python}} |
|||
<syntaxhighlight lang="11l">F halve(x) |
|||
R x I/ 2 |
|||
F double(x) |
|||
R x * 2 |
|||
F even(x) |
|||
R !(x % 2) |
|||
F ethiopian(=multiplier, =multiplicand) |
|||
V result = 0 |
|||
L multiplier >= 1 |
|||
I !even(multiplier) |
|||
result += multiplicand |
|||
multiplier = halve(multiplier) |
|||
multiplicand = double(multiplicand) |
|||
R result |
|||
print(ethiopian(17, 34))</syntaxhighlight> |
|||
{{out}} |
|||
<pre>578</pre> |
|||
=={{header|8080 Assembly}}== |
|||
The 8080 does not have a hardware multiplier, but it does have addition and rotation, |
|||
so this code is actually useful. Indeed, it is pretty much the standard algorithm |
|||
for general multiplication on processors that do not have a hardware multiplier. |
|||
You would not normally name the sections (halve, double, even), since they |
|||
rely on each other and cannot be called independently. Pulling them out |
|||
entirely would entail a performance hit and make the whole thing much |
|||
less elegant, so I've done it this way as a sort of compromise. |
|||
<syntaxhighlight lang="8080asm"> org 100h |
|||
jmp demo |
|||
;;; HL = BC * DE |
|||
;;; BC is left column, DE is right column |
|||
emul: lxi h,0 ; HL will be the accumulator |
|||
ztest: mov a,b ; Check if the left column is zero. |
|||
ora c ; If so, stop. |
|||
rz |
|||
halve: mov a,b ; Halve BC by rotating it right. |
|||
rar ; We know the carry is zero here because of the ORA. |
|||
mov b,a ; So rotate the top half first, |
|||
mov a,c ; Then the bottom half |
|||
rar ; This leaves the old low bit in the carry flag, |
|||
mov c,a ; so this also lets us do the even/odd test in one go. |
|||
even: jnc $+4 ; If no carry, the number is even, so skip (strikethrough) |
|||
dad d ; But if odd, add the number in the right column |
|||
double: xchg ; Doubling DE is a bit easier since you can add |
|||
dad h ; HL to itself in one go, and XCHG swaps DE and HL |
|||
xchg |
|||
jmp ztest ; We want to do the whole thing again until BC is zero |
|||
;;; Demo code, print 17 * 34 |
|||
demo: lxi b,17 ; Load 17 into BC (left column) |
|||
lxi d,34 ; Load 34 into DE (right column) |
|||
call emul ; Do the multiplication |
|||
print: lxi b,-10 ; Decimal output routine (not very interesting here, |
|||
lxi d,pbuf ; but without it you can't see the result) |
|||
push d |
|||
digit: lxi d,-1 |
|||
dloop: inx d |
|||
dad b |
|||
jc dloop |
|||
mvi a,58 |
|||
add l |
|||
pop h |
|||
dcx h |
|||
mov m,a |
|||
push h |
|||
xchg |
|||
mov a,h |
|||
ora l |
|||
jnz digit |
|||
pop d |
|||
mvi c,9 |
|||
jmp 5 |
|||
db '*****' |
|||
pbuf: db '$'</syntaxhighlight> |
|||
{{out}} |
|||
<pre>578</pre> |
|||
=={{header|AArch64 Assembly}}== |
|||
{{works with|as|Raspberry Pi 3B version Buster 64 bits <br> or android 64 bits with application Termux }} |
|||
<syntaxhighlight lang AArch64 Assembly> |
|||
/* ARM assembly AARCH64 Raspberry PI 3B */ |
|||
/* program multieth64.s */ |
|||
/************************************/ |
|||
/* Constantes */ |
|||
/************************************/ |
|||
.include "../includeConstantesARM64.inc" |
|||
/*********************************/ |
|||
/* Initialized data */ |
|||
/*********************************/ |
|||
.data |
|||
szMessResult: .asciz "Result : " |
|||
szMessStart: .asciz "Program 64 bits start.\n" |
|||
szCarriageReturn: .asciz "\n" |
|||
szMessErreur: .asciz "Error overflow. \n" |
|||
/*********************************/ |
|||
/* UnInitialized data */ |
|||
/*********************************/ |
|||
.bss |
|||
sZoneConv: .skip 24 |
|||
/*********************************/ |
|||
/* code section */ |
|||
/*********************************/ |
|||
.text |
|||
.global main |
|||
main: // entry of program |
|||
ldr x0,qAdrszMessStart |
|||
bl affichageMess |
|||
mov x0,#17 |
|||
mov x1,#34 |
|||
bl multEthiop |
|||
ldr x1,qAdrsZoneConv |
|||
bl conversion10 // decimal conversion |
|||
mov x0,#3 // number string to display |
|||
ldr x1,qAdrszMessResult |
|||
ldr x2,qAdrsZoneConv // insert conversion in message |
|||
ldr x3,qAdrszCarriageReturn |
|||
bl displayStrings // display message |
|||
100: // standard end of the program |
|||
mov x0, #0 // return code |
|||
mov x8,EXIT |
|||
svc #0 // perform the system call |
|||
qAdrszCarriageReturn: .quad szCarriageReturn |
|||
qAdrsZoneConv: .quad sZoneConv |
|||
qAdrszMessResult: .quad szMessResult |
|||
qAdrszMessErreur: .quad szMessErreur |
|||
qAdrszMessStart: .quad szMessStart |
|||
/******************************************************************/ |
|||
/* Ethiopian multiplication unsigned */ |
|||
/******************************************************************/ |
|||
/* x0 first factor */ |
|||
/* x1 2th factor */ |
|||
/* x0 return résult */ |
|||
multEthiop: |
|||
stp x1,lr,[sp,-16]! // save registers |
|||
stp x2,x3,[sp,-16]! // save registers |
|||
mov x2,#0 // init result |
|||
1: // loop |
|||
cmp x0,#1 // end ? |
|||
blt 3f |
|||
ands x3,x0,#1 // |
|||
add x3,x2,x1 // add factor2 to result |
|||
csel x2,x2,x3,eq |
|||
mov x3,1 |
|||
lsr x0,x0,x3 // divide factor1 by 2 |
|||
cmp x1,0 // overflow ? if bit 63 = 1 ie negative number |
|||
blt 2f |
|||
mov x4,1 |
|||
lsl x1,x1,x4 // multiply factor2 by 2 |
|||
b 1b // or loop |
|||
2: // error display |
|||
ldr x0,qAdrszMessErreur |
|||
bl affichageMess |
|||
mov x2,#0 |
|||
3: |
|||
mov x0,x2 // return result |
|||
ldp x2,x3,[sp],16 // restaur registers |
|||
ldp x1,lr,[sp],16 // restaur registers |
|||
ret |
|||
/***************************************************/ |
|||
/* display multi strings */ |
|||
/***************************************************/ |
|||
/* x0 contains number strings address */ |
|||
/* x1 address string1 */ |
|||
/* x2 address string2 */ |
|||
/* x3 address string3 */ |
|||
/* other address on the stack */ |
|||
/* thinck to add number other address * 8 to add to the stack */ |
|||
displayStrings: // INFO: displayStrings |
|||
stp x1,lr,[sp,-16]! // save registers |
|||
stp x2,x3,[sp,-16]! // save registers |
|||
stp x4,x5,[sp,-16]! // save registers |
|||
add fp,sp,#48 // save paraméters address (6 registers saved * 4 bytes) |
|||
mov x4,x0 // save strings number |
|||
cmp x4,#0 // 0 string -> end |
|||
ble 100f |
|||
mov x0,x1 // string 1 |
|||
bl affichageMess |
|||
cmp x4,#1 // number > 1 |
|||
ble 100f |
|||
mov x0,x2 |
|||
bl affichageMess |
|||
cmp x4,#2 |
|||
ble 100f |
|||
mov x0,x3 |
|||
bl affichageMess |
|||
cmp x4,#3 |
|||
ble 100f |
|||
mov x3,#3 |
|||
sub x2,x4,#8 |
|||
1: // loop extract address string on stack |
|||
ldr x0,[fp,x2,lsl #3] |
|||
bl affichageMess |
|||
subs x2,x2,#1 |
|||
bge 1b |
|||
100: |
|||
ldp x4,x5,[sp],16 // restaur registers |
|||
ldp x2,x3,[sp],16 // restaur registers |
|||
ldp x1,lr,[sp],16 // restaur registers |
|||
ret |
|||
/***************************************************/ |
|||
/* ROUTINES INCLUDE */ |
|||
/***************************************************/ |
|||
.include "../includeARM64.inc" |
|||
</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
Program 64 bits start. |
|||
Result : 578 |
|||
</pre> |
|||
=={{header|ACL2}}== |
|||
<syntaxhighlight lang="lisp">(include-book "arithmetic-3/top" :dir :system) |
|||
(defun halve (x) |
|||
(floor x 2)) |
|||
(defun double (x) |
|||
(* x 2)) |
|||
(defun is-even (x) |
|||
(evenp x)) |
|||
(defun multiply (x y) |
|||
(if (zp (1- x)) |
|||
y |
|||
(+ (if (is-even x) |
|||
0 |
|||
y) |
|||
(multiply (halve x) (double y)))))</syntaxhighlight> |
|||
=={{header|Action!}}== |
|||
<syntaxhighlight lang="action!">INT FUNC EthopianMult(INT a,b) |
|||
INT res |
|||
PrintF("Ethopian multiplication %I by %I:%E",a,b) |
|||
res=0 |
|||
WHILE a>=1 |
|||
DO |
|||
IF a MOD 2=0 THEN |
|||
PrintF("%I %I strike%E",a,b) |
|||
ELSE |
|||
PrintF("%I %I keep%E",a,b) |
|||
res==+b |
|||
FI |
|||
a==/2 |
|||
b==*2 |
|||
OD |
|||
RETURN (res) |
|||
PROC Main() |
|||
INT res |
|||
res=EthopianMult(17,34) |
|||
PrintF("Result is %I",res) |
|||
RETURN</syntaxhighlight> |
|||
{{out}} |
|||
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Ethiopian_multiplication.png Screenshot from Atari 8-bit computer] |
|||
<pre> |
|||
Ethopian multiplication 17 by 34: |
|||
17 34 keep |
|||
8 68 strike |
|||
4 136 strike |
|||
2 272 strike |
|||
1 544 keep |
|||
Result is 578 |
|||
</pre> |
|||
=={{header|ActionScript}}== |
|||
{{works with|ActionScript|2.0}} |
|||
<syntaxhighlight lang="actionscript">function Divide(a:Number):Number { |
|||
return ((a-(a%2))/2); |
|||
} |
|||
function Multiply(a:Number):Number { |
|||
return (a *= 2); |
|||
} |
|||
function isEven(a:Number):Boolean { |
|||
if (a%2 == 0) { |
|||
return (true); |
|||
} else { |
|||
return (false); |
|||
} |
|||
} |
|||
function Ethiopian(left:Number, right:Number) { |
|||
var r:Number = 0; |
|||
trace(left+" "+right); |
|||
while (left != 1) { |
|||
var State:String = "Keep"; |
|||
if (isEven(Divide(left))) { |
|||
State = "Strike"; |
|||
} |
|||
trace(Divide(left)+" "+Multiply(right)+" "+State); |
|||
left = Divide(left); |
|||
right = Multiply(right); |
|||
if (State == "Keep") { |
|||
r += right; |
|||
} |
|||
} |
|||
trace("="+" "+r); |
|||
} |
|||
}</syntaxhighlight>{{out}} |
|||
ex. Ethiopian(17,34); |
|||
17 34 |
|||
8 68 Strike |
|||
4 136 Strike |
|||
2 272 Strike |
|||
1 544 Keep |
|||
=={{header|Ada}}== |
=={{header|Ada}}== |
||
<syntaxhighlight lang="ada"> |
|||
<lang Ada>package Ethiopian is |
|||
with ada.text_io;use ada.text_io; |
|||
function Multiply(Left, Right : Integer) return Integer; |
|||
end Ethiopian;</lang> |
|||
procedure ethiopian is |
|||
<lang Ada>package body Ethiopian is |
|||
function double (n : Natural) return Natural is (2*n); |
|||
function halve (n : Natural) return Natural is (n/2); |
|||
begin |
|||
return |
function is_even (n : Natural) return Boolean is (n mod 2 = 0); |
||
end Is_Even; |
|||
function mul (l, r : Natural) return Natural is |
|||
(if l = 0 then 0 elsif l = 1 then r elsif is_even (l) then mul (halve (l),double (r)) |
|||
function Double(Item : Integer) return Integer is |
|||
else r + double (mul (halve (l), r))); |
|||
begin |
|||
return Item * 2; |
|||
end Double; |
|||
begin |
|||
function Half(Item : Integer) return Integer is |
|||
put_line (mul (17,34)'img); |
|||
begin |
|||
end ethiopian;</syntaxhighlight> |
|||
return Item / 2; |
|||
end Half; |
|||
function Multiply(Left, Right : Integer) return Integer is |
|||
Temp : Integer := 0; |
|||
Plier : Integer := Left; |
|||
Plicand : Integer := Right; |
|||
begin |
|||
while Plier >= 1 loop |
|||
if not Is_Even(Plier) then |
|||
Temp := Temp + Plicand; |
|||
end if; |
|||
Plier := Half(Plier); |
|||
Plicand := Double(Plicand); |
|||
end loop; |
|||
return Temp; |
|||
end Multiply; |
|||
end Ethiopian;</lang> |
|||
=={{header|Aime}}== |
|||
<lang Ada>with Ethiopian; use Ethiopian; |
|||
{{trans|C}} |
|||
with Ada.Text_Io; use Ada.Text_Io; |
|||
<syntaxhighlight lang="aime">void |
|||
halve(integer &x) |
|||
{ |
|||
x >>= 1; |
|||
} |
|||
void |
|||
double(integer &x) |
|||
{ |
|||
x <<= 1; |
|||
} |
|||
integer |
|||
iseven(integer x) |
|||
{ |
|||
return (x & 1) == 0; |
|||
} |
|||
integer |
|||
ethiopian(integer plier, integer plicand, integer tutor) |
|||
{ |
|||
integer result; |
|||
result = 0; |
|||
if (tutor) { |
|||
o_form("ethiopian multiplication of ~ by ~\n", plier, plicand); |
|||
} |
|||
while (plier >= 1) { |
|||
if (iseven(plier)) { |
|||
if (tutor) { |
|||
o_form("/w4/ /w6/ struck\n", plier, plicand); |
|||
} |
|||
} else { |
|||
if (tutor) { |
|||
o_form("/w4/ /w6/ kept\n", plier, plicand); |
|||
} |
|||
result += plicand; |
|||
} |
|||
halve(plier); |
|||
double(plicand); |
|||
} |
|||
return result; |
|||
} |
|||
integer |
|||
main(void) |
|||
{ |
|||
o_integer(ethiopian(17, 34, 1)); |
|||
o_byte('\n'); |
|||
return 0; |
|||
}</syntaxhighlight> |
|||
17 34 kept |
|||
8 68 struck |
|||
4 136 struck |
|||
2 272 struck |
|||
1 544 kept |
|||
578 |
|||
procedure Ethiopian_Test is |
|||
First : Integer := 17; |
|||
Second : Integer := 34; |
|||
begin |
|||
Put_Line(Integer'Image(First) & " times " & |
|||
Integer'Image(Second) & " = " & |
|||
Integer'Image(Multiply(First, Second))); |
|||
end Ethiopian_Test;</lang> |
|||
=={{header|ALGOL 68}}== |
=={{header|ALGOL 68}}== |
||
{{trans|C}} |
{{trans|C}} |
||
Line 106: | Line 481: | ||
<!-- {{does not work with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release 1.8.8d.fc9.i386 - missing printf and FORMAT}} --> |
<!-- {{does not work with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release 1.8.8d.fc9.i386 - missing printf and FORMAT}} --> |
||
<syntaxhighlight lang="algol68">PROC halve = (REF INT x)VOID: x := ABS(BIN x SHR 1); |
|||
<lang algol> |
|||
PROC halve = (REF INT x)VOID: x := ABS(BIN x SHR 1); |
|||
PROC doublit = (REF INT x)VOID: x := ABS(BIN x SHL 1); |
PROC doublit = (REF INT x)VOID: x := ABS(BIN x SHL 1); |
||
PROC iseven = (#CONST# INT x)BOOL: NOT ODD x; |
PROC iseven = (#CONST# INT x)BOOL: NOT ODD x; |
||
Line 135: | Line 509: | ||
( |
( |
||
printf(($g(0)l$, ethiopian(17, 34, TRUE))) |
printf(($g(0)l$, ethiopian(17, 34, TRUE))) |
||
)</syntaxhighlight>{{out}} |
|||
) |
|||
ethiopian multiplication of 17 by 34 |
|||
</lang> |
|||
Output: |
|||
<pre> |
|||
ethiopian multiplication of 17 by 34 |
|||
0017 000034 kept |
0017 000034 kept |
||
0008 000068 struck |
0008 000068 struck |
||
Line 145: | Line 516: | ||
0002 000272 struck |
0002 000272 struck |
||
0001 000544 kept |
0001 000544 kept |
||
578 |
578 |
||
=={{header|ALGOL-M}}== |
|||
<syntaxhighlight lang="algol"> |
|||
BEGIN |
|||
INTEGER FUNCTION HALF(I); |
|||
INTEGER I; |
|||
BEGIN |
|||
HALF := I / 2; |
|||
END; |
|||
INTEGER FUNCTION DOUBLE(I); |
|||
INTEGER I; |
|||
BEGIN |
|||
DOUBLE := I + I; |
|||
END; |
|||
% RETURN 1 IF EVEN, OTHERWISE 0 % |
|||
INTEGER FUNCTION EVEN(I); |
|||
INTEGER I; |
|||
BEGIN |
|||
EVEN := 1 - (I - 2 * (I / 2)); |
|||
END; |
|||
% RETURN I * J AND OPTIONALLY SHOW COMPUTATIONAL STEPS % |
|||
INTEGER FUNCTION ETHIOPIAN(I, J, SHOW); |
|||
INTEGER I, J, SHOW; |
|||
BEGIN |
|||
INTEGER P, YES; |
|||
YES := 1; |
|||
P := 0; |
|||
WHILE I >= 1 DO |
|||
BEGIN |
|||
IF EVEN(I) = YES THEN |
|||
BEGIN |
|||
IF SHOW = YES THEN WRITE(I," ----", J); |
|||
END |
|||
ELSE |
|||
BEGIN |
|||
IF SHOW = YES THEN WRITE(I,J); |
|||
P := P + J; |
|||
END; |
|||
I := HALF(I); |
|||
J := DOUBLE(J); |
|||
END; |
|||
IF SHOW = YES THEN WRITE(" ="); |
|||
ETHIOPIAN := P; |
|||
END; |
|||
% EXERCISE THE FUNCTION % |
|||
INTEGER YES; |
|||
YES := 1; |
|||
WRITE(ETHIOPIAN(17,34,YES)); |
|||
END</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
17 34 |
|||
8 ---- 68 |
|||
4 ---- 136 |
|||
2 ---- 272 |
|||
1 544 |
|||
= 578 |
|||
</pre> |
</pre> |
||
=={{header|ALGOL W}}== |
|||
<syntaxhighlight lang="algolw">begin |
|||
% returns half of a % |
|||
integer procedure halve ( integer value a ) ; a div 2; |
|||
% returns a doubled % |
|||
integer procedure double ( integer value a ) ; a * 2; |
|||
% returns true if a is even, false otherwise % |
|||
logical procedure even ( integer value a ) ; not odd( a ); |
|||
% returns the product of a and b using ethopian multiplication % |
|||
% rather than keep a table of the intermediate results, % |
|||
% we examine then as they are generated % |
|||
integer procedure ethopianMultiplication ( integer value a, b ) ; |
|||
begin |
|||
integer v, r, accumulator; |
|||
v := a; |
|||
r := b; |
|||
accumulator := 0; |
|||
i_w := 4; s_w := 0; % set output formatting % |
|||
while begin |
|||
write( v ); |
|||
if even( v ) then writeon( " ---" ) |
|||
else begin |
|||
accumulator := accumulator + r; |
|||
writeon( " ", r ); |
|||
end; |
|||
v := halve( v ); |
|||
r := double( r ); |
|||
v > 0 |
|||
end do begin end; |
|||
write( " =====" ); |
|||
accumulator |
|||
end ethopianMultiplication ; |
|||
% task test case % |
|||
begin |
|||
integer m; |
|||
m := ethopianMultiplication( 17, 34 ); |
|||
write( " ", m ) |
|||
end |
|||
end.</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
17 34 |
|||
8 --- |
|||
4 --- |
|||
2 --- |
|||
1 544 |
|||
===== |
|||
578 |
|||
</pre> |
|||
=={{header|AppleScript}}== |
|||
{{trans|JavaScript}} |
|||
Note that this algorithm, already described in the Rhind Papyrus (c. BCE 1650), can be used to multiply strings as well as integers, if we change the identity element from 0 to the empty string, and replace integer addition with string concatenation. |
|||
See also: [[Repeat_a_string#AppleScript]] |
|||
<syntaxhighlight lang="applescript">on run |
|||
{ethMult(17, 34), ethMult("Rhind", 9)} |
|||
--> {578, "RhindRhindRhindRhindRhindRhindRhindRhind"} |
|||
end run |
|||
-- Int -> Int -> Int |
|||
-- or |
|||
-- Int -> String -> String |
|||
on ethMult(m, n) |
|||
script fns |
|||
property identity : missing value |
|||
property plus : missing value |
|||
on half(n) -- 1. half an integer (div 2) |
|||
n div 2 |
|||
end half |
|||
on double(n) -- 2. double (add to self) |
|||
plus(n, n) |
|||
end double |
|||
on isEven(n) -- 3. is n even ? (mod 2 > 0) |
|||
(n mod 2) > 0 |
|||
end isEven |
|||
on chooseFns(c) |
|||
if c is string then |
|||
set identity of fns to "" |
|||
set plus of fns to plusString of fns |
|||
else |
|||
set identity of fns to 0 |
|||
set plus of fns to plusInteger of fns |
|||
end if |
|||
end chooseFns |
|||
on plusInteger(a, b) |
|||
a + b |
|||
end plusInteger |
|||
on plusString(a, b) |
|||
a & b |
|||
end plusString |
|||
end script |
|||
chooseFns(class of m) of fns |
|||
-- MAIN PROCESS OF CALCULATION |
|||
set o to identity of fns |
|||
if n < 1 then return o |
|||
repeat while (n > 1) |
|||
if isEven(n) of fns then -- 3. is n even ? (mod 2 > 0) |
|||
set o to plus(o, m) of fns |
|||
end if |
|||
set n to half(n) of fns -- 1. half an integer (div 2) |
|||
set m to double(m) of fns -- 2. double (add to self) |
|||
end repeat |
|||
return plus(o, m) of fns |
|||
end ethMult</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>{578, "RhindRhindRhindRhindRhindRhindRhindRhindRhind"}</pre> |
|||
=={{header|ARM Assembly}}== |
|||
{{works with|as|Raspberry Pi <br> or android 32 bits with application Termux}} |
|||
<syntaxhighlight lang ARM Assembly> |
|||
/* ARM assembly Raspberry PI */ |
|||
/* program multieth.s */ |
|||
/* REMARK 1 : this program use routines in a include file |
|||
see task Include a file language arm assembly |
|||
for the routine affichageMess conversion10 |
|||
see at end of this program the instruction include */ |
|||
/* for constantes see task include a file in arm assembly */ |
|||
/************************************/ |
|||
/* Constantes */ |
|||
/************************************/ |
|||
.include "../constantes.inc" |
|||
/*********************************/ |
|||
/* Initialized data */ |
|||
/*********************************/ |
|||
.data |
|||
szMessResult: .asciz "Result : " |
|||
szMessStart: .asciz "Program 32 bits start.\n" |
|||
szCarriageReturn: .asciz "\n" |
|||
szMessErreur: .asciz "Error overflow. \n" |
|||
/*********************************/ |
|||
/* UnInitialized data */ |
|||
/*********************************/ |
|||
.bss |
|||
sZoneConv: .skip 24 |
|||
/*********************************/ |
|||
/* code section */ |
|||
/*********************************/ |
|||
.text |
|||
.global main |
|||
main: @ entry of program |
|||
ldr r0,iAdrszMessStart |
|||
bl affichageMess |
|||
mov r0,#17 |
|||
mov r1,#34 |
|||
bl multEthiop |
|||
ldr r1,iAdrsZoneConv |
|||
bl conversion10 @ decimal conversion |
|||
mov r0,#3 @ number string to display |
|||
ldr r1,iAdrszMessResult |
|||
ldr r2,iAdrsZoneConv @ insert conversion in message |
|||
ldr r3,iAdrszCarriageReturn |
|||
bl displayStrings @ display message |
|||
100: @ standard end of the program |
|||
mov r0, #0 @ return code |
|||
mov r7, #EXIT @ request to exit program |
|||
svc #0 @ perform the system call |
|||
iAdrszCarriageReturn: .int szCarriageReturn |
|||
iAdrsZoneConv: .int sZoneConv |
|||
iAdrszMessResult: .int szMessResult |
|||
iAdrszMessErreur: .int szMessErreur |
|||
iAdrszMessStart: .int szMessStart |
|||
/******************************************************************/ |
|||
/* Ethiopian multiplication */ |
|||
/******************************************************************/ |
|||
/* r0 first factor */ |
|||
/* r1 2th factor */ |
|||
/* r0 return résult */ |
|||
multEthiop: |
|||
push {r1-r3,lr} @ save registers |
|||
mov r2,#0 @ init result |
|||
1: @ loop |
|||
cmp r0,#1 @ end ? |
|||
blt 3f |
|||
ands r3,r0,#1 @ |
|||
addne r2,r1 @ add factor2 to result |
|||
lsr r0,#1 @ divide factor1 by 2 |
|||
lsls r1,#1 @ multiply factor2 by 2 |
|||
bcs 2f @ overflow ? |
|||
b 1b @ or loop |
|||
2: @ error display |
|||
ldr r0,iAdrszMessErreur |
|||
bl affichageMess |
|||
mov r2,#0 |
|||
3: |
|||
mov r0,r2 @ return result |
|||
pop {r1-r3,pc} |
|||
/***************************************************/ |
|||
/* display multi strings */ |
|||
/***************************************************/ |
|||
/* r0 contains number strings address */ |
|||
/* r1 address string1 */ |
|||
/* r2 address string2 */ |
|||
/* r3 address string3 */ |
|||
/* other address on the stack */ |
|||
/* thinck to add number other address * 4 to add to the stack */ |
|||
displayStrings: @ INFO: displayStrings |
|||
push {r1-r4,fp,lr} @ save des registres |
|||
add fp,sp,#24 @ save paraméters address (6 registers saved * 4 bytes) |
|||
mov r4,r0 @ save strings number |
|||
cmp r4,#0 @ 0 string -> end |
|||
ble 100f |
|||
mov r0,r1 @ string 1 |
|||
bl affichageMess |
|||
cmp r4,#1 @ number > 1 |
|||
ble 100f |
|||
mov r0,r2 |
|||
bl affichageMess |
|||
cmp r4,#2 |
|||
ble 100f |
|||
mov r0,r3 |
|||
bl affichageMess |
|||
cmp r4,#3 |
|||
ble 100f |
|||
mov r3,#3 |
|||
sub r2,r4,#4 |
|||
1: @ loop extract address string on stack |
|||
ldr r0,[fp,r2,lsl #2] |
|||
bl affichageMess |
|||
subs r2,#1 |
|||
bge 1b |
|||
100: |
|||
pop {r1-r4,fp,pc} |
|||
/***************************************************/ |
|||
/* ROUTINES INCLUDE */ |
|||
/***************************************************/ |
|||
.include "../affichage.inc" |
|||
</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
Program 32 bits start. |
|||
Result : 578 |
|||
</pre> |
|||
=={{header|Arturo}}== |
|||
<syntaxhighlight lang="rebol">halve: function [x]-> shr x 1 |
|||
double: function [x]-> shl x 1 |
|||
; even? already exists |
|||
ethiopian: function [x y][ |
|||
prod: 0 |
|||
while [x > 0][ |
|||
unless even? x [prod: prod + y] |
|||
x: halve x |
|||
y: double y |
|||
] |
|||
return prod |
|||
] |
|||
print ethiopian 17 34 |
|||
print ethiopian 2 3</syntaxhighlight> |
|||
{{out}} |
|||
<pre>578 |
|||
6</pre> |
|||
=={{header|AutoHotkey}}== |
=={{header|AutoHotkey}}== |
||
< |
<syntaxhighlight lang="autohotkey">MsgBox % Ethiopian(17, 34) "`n" Ethiopian2(17, 34) |
||
; func definitions: |
; func definitions: |
||
Line 178: | Line 897: | ||
Ethiopian2( a, b, r = 0 ) { ;omit r param on initial call |
Ethiopian2( a, b, r = 0 ) { ;omit r param on initial call |
||
return a==1 ? r+b : Ethiopian2( half(a), double(b), !isEven(a) ? r+b : r ) |
return a==1 ? r+b : Ethiopian2( half(a), double(b), !isEven(a) ? r+b : r ) |
||
}</ |
}</syntaxhighlight> |
||
=={{header|AutoIt}}== |
|||
<syntaxhighlight lang="autoit"> |
|||
Func Halve($x) |
|||
Return Int($x/2) |
|||
EndFunc |
|||
Func Double($x) |
|||
Return ($x*2) |
|||
EndFunc |
|||
Func IsEven($x) |
|||
Return (Mod($x,2) == 0) |
|||
EndFunc |
|||
; this version also supports negative parameters |
|||
Func Ethiopian($nPlier, $nPlicand, $bTutor = True) |
|||
Local $nResult = 0 |
|||
If ($nPlier < 0) Then |
|||
$nPlier =- $nPlier |
|||
$nPlicand =- $nPlicand |
|||
ElseIf ($nPlicand > 0) And ($nPlier > $nPlicand) Then |
|||
$nPlier = $nPlicand |
|||
$nPlicand = $nPlier |
|||
EndIf |
|||
If $bTutor Then _ |
|||
ConsoleWrite(StringFormat("Ethiopian multiplication of %d by %d...\n", $nPlier, $nPlicand)) |
|||
While ($nPlier >= 1) |
|||
If Not IsEven($nPlier) Then |
|||
$nResult += $nPlicand |
|||
If $bTutor Then ConsoleWrite(StringFormat("%d\t%d\tKeep\n", $nPlier, $nPlicand)) |
|||
Else |
|||
If $bTutor Then ConsoleWrite(StringFormat("%d\t%d\tStrike\n", $nPlier, $nPlicand)) |
|||
EndIf |
|||
$nPlier = Halve($nPlier) |
|||
$nPlicand = Double($nPlicand) |
|||
WEnd |
|||
If $bTutor Then ConsoleWrite(StringFormat("Answer = %d\n", $nResult)) |
|||
Return $nResult |
|||
EndFunc |
|||
MsgBox(0, "Ethiopian multiplication of 17 by 34", Ethiopian(17, 34) ) |
|||
</syntaxhighlight> |
|||
=={{header|AWK}}== |
=={{header|AWK}}== |
||
Implemented without the tutor. |
Implemented without the tutor. |
||
< |
<syntaxhighlight lang="awk">function halve(x) |
||
{ |
{ |
||
return int(x/2) |
return int(x/2) |
||
Line 212: | Line 974: | ||
BEGIN { |
BEGIN { |
||
print ethiopian(17, 34) |
print ethiopian(17, 34) |
||
}</ |
}</syntaxhighlight> |
||
=={{header|BASIC}}== |
|||
==={{header|Applesoft BASIC}}=== |
|||
Same code as [[#Nascom_BASIC|Nascom BASIC]] |
|||
==={{header|ASIC}}=== |
|||
<syntaxhighlight lang="basic"> |
|||
REM Ethiopian multiplication |
|||
X = 17 |
|||
Y = 34 |
|||
TOT = 0 |
|||
WHILE X >= 1 |
|||
PRINT X; |
|||
PRINT " "; |
|||
A = X |
|||
GOSUB CHECKEVEN: |
|||
IF ISEVEN = 0 THEN |
|||
TOT = TOT + Y |
|||
PRINT Y; |
|||
ENDIF |
|||
PRINT |
|||
A = X |
|||
GOSUB HALVE: |
|||
X = A |
|||
A = Y |
|||
GOSUB DOUBLE: |
|||
Y = A |
|||
WEND |
|||
PRINT "= "; |
|||
PRINT TOT |
|||
END |
|||
REM Subroutines are required, though |
|||
REM they complicate the code |
|||
DOUBLE: |
|||
A = 2 * A |
|||
RETURN |
|||
HALVE: |
|||
A = A / 2 |
|||
RETURN |
|||
CHECKEVEN: |
|||
REM ISEVEN - result (0 if A odd, 1 otherwise) |
|||
ISEVEN = A MOD 2 |
|||
ISEVEN = 1 - ISEVEN |
|||
RETURN |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
17 34 |
|||
8 |
|||
4 |
|||
2 |
|||
1 544 |
|||
= 578 |
|||
</pre> |
|||
==={{header|BASIC}}=== |
|||
Works with QBasic. While building the table, it's easier to simply not print unused values, rather than have to go back and strike them out afterward. (Both that and the actual adding happen in the "IF NOT (isEven(x))" block.) |
|||
<syntaxhighlight lang="qbasic">DECLARE FUNCTION half% (a AS INTEGER) |
|||
DECLARE FUNCTION doub% (a AS INTEGER) |
|||
DECLARE FUNCTION isEven% (a AS INTEGER) |
|||
DIM x AS INTEGER, y AS INTEGER, outP AS INTEGER |
|||
x = 17 |
|||
y = 34 |
|||
DO |
|||
PRINT x, |
|||
IF NOT (isEven(x)) THEN |
|||
outP = outP + y |
|||
PRINT y |
|||
ELSE |
|||
PRINT |
|||
END IF |
|||
IF x < 2 THEN EXIT DO |
|||
x = half(x) |
|||
y = doub(y) |
|||
LOOP |
|||
PRINT " =", outP |
|||
FUNCTION doub% (a AS INTEGER) |
|||
doub% = a * 2 |
|||
END FUNCTION |
|||
FUNCTION half% (a AS INTEGER) |
|||
half% = a \ 2 |
|||
END FUNCTION |
|||
FUNCTION isEven% (a AS INTEGER) |
|||
isEven% = (a MOD 2) - 1 |
|||
END FUNCTION</syntaxhighlight> |
|||
{{out}} |
|||
<pre> 17 34 |
|||
8 |
|||
4 |
|||
2 |
|||
1 544 |
|||
= 578</pre> |
|||
==={{header|BASIC256}}=== |
|||
<syntaxhighlight lang="vbnet">outP = 0 |
|||
x = 17 |
|||
y = 34 |
|||
while True |
|||
print x + chr(09); |
|||
if not (isEven(x)) then |
|||
outP += y |
|||
print y |
|||
else |
|||
print |
|||
end if |
|||
if x < 2 then exit while |
|||
x = half(x) |
|||
y = doub(y) |
|||
end while |
|||
print "=" + chr(09); outP |
|||
end |
|||
function doub (a) |
|||
return a * 2 |
|||
end function |
|||
function half (a) |
|||
return a \ 2 |
|||
end function |
|||
function isEven (a) |
|||
return (a mod 2) - 1 |
|||
end function</syntaxhighlight> |
|||
==={{header|BBC BASIC}}=== |
|||
<syntaxhighlight lang="bbcbasic"> x% = 17 |
|||
y% = 34 |
|||
REPEAT |
|||
IF NOT FNeven(x%) THEN |
|||
p% += y% |
|||
PRINT x%, y% |
|||
ELSE |
|||
PRINT x%, " ---" |
|||
ENDIF |
|||
x% = FNhalve(x%) |
|||
y% = FNdouble(y%) |
|||
UNTIL x% = 0 |
|||
PRINT " " , " ===" |
|||
PRINT " " , p% |
|||
END |
|||
DEF FNdouble(A%) = A% * 2 |
|||
DEF FNhalve(A%) = A% DIV 2 |
|||
DEF FNeven(A%) = ((A% AND 1) = 0)</syntaxhighlight> |
|||
{{out}} |
|||
<pre> 17 34 |
|||
8 --- |
|||
4 --- |
|||
2 --- |
|||
1 544 |
|||
=== |
|||
578</pre> |
|||
==={{header|Chipmunk Basic}}=== |
|||
{{trans|BASIC256}} |
|||
{{works with|Chipmunk Basic|3.6.4}} |
|||
<syntaxhighlight lang="vbnet">100 sub doub(a) |
|||
110 doub = a*2 |
|||
120 end sub |
|||
130 sub half(a) |
|||
140 half = int(a/2) |
|||
150 end sub |
|||
160 sub iseven(a) |
|||
170 iseven = (a mod 2)-1 |
|||
180 end sub |
|||
190 outp = 0 |
|||
200 x = 17 |
|||
210 y = 34 |
|||
220 while 1 |
|||
230 print x;chr$(9); |
|||
240 if not (iseven(x)) then |
|||
250 outp = outp - y |
|||
260 print y |
|||
270 else |
|||
280 print |
|||
290 endif |
|||
300 if x < 2 then exit while |
|||
310 x = half(x) |
|||
320 y = doub(y) |
|||
330 wend |
|||
340 print "=";chr$(9);outp |
|||
350 end</syntaxhighlight> |
|||
==={{header|FreeBASIC}}=== |
|||
<syntaxhighlight lang="freebasic">Function double_(y As String) As String |
|||
Var answer="0"+y |
|||
Var addcarry=0 |
|||
For n_ As Integer=Len(y)-1 To 0 Step -1 |
|||
Var addup=y[n_]+y[n_]-96 |
|||
answer[n_+1]=(addup+addcarry) Mod 10+48 |
|||
addcarry=(-(10<=(addup+addcarry))) |
|||
Next n_ |
|||
answer[0]=addcarry+48 |
|||
Return Ltrim(answer,"0") |
|||
End Function |
|||
Function Accumulate(NUM1 As String,NUM2 As String) As String |
|||
Var three="0"+NUM1 |
|||
Var two=String(len(NUM1)-len(NUM2),"0")+NUM2 |
|||
Var addcarry=0 |
|||
For n2 As Integer=len(NUM1)-1 To 0 Step -1 |
|||
Var addup=two[n2]+NUM1[n2]-96 |
|||
three[n2+1]=(addup+addcarry) Mod 10+48 |
|||
addcarry=(-(10<=(addup+addcarry))) |
|||
Next n2 |
|||
three[0]=addcarry+48 |
|||
three=Ltrim(three,"0") |
|||
If three="" Then Return "0" |
|||
Return three |
|||
End Function |
|||
Function Half(Byref x As String) As String |
|||
Var carry=0 |
|||
For z As Integer=0 To Len(x)-1 |
|||
Var temp=(x[z]-48+carry) |
|||
Var main=temp Shr 1 |
|||
carry=(temp And 1) Shl 3 +(temp And 1) Shl 1 |
|||
x[z]=main+48 |
|||
Next z |
|||
x= Ltrim(x,"0") |
|||
Return x |
|||
End Function |
|||
Function IsEven(x As String) As Integer |
|||
If x[Len(x)-1] And 1 Then Return 0 |
|||
return -1 |
|||
End Function |
|||
Function EthiopianMultiply(n1 As String,n2 As String) As String |
|||
Dim As String x=n1,y=n2 |
|||
If Len(y)>Len(x) Then Swap y,x |
|||
'set the largest one to be halfed |
|||
If Len(y)=Len(x) Then |
|||
If x<y Then Swap y,x |
|||
End If |
|||
Dim As String ans |
|||
Dim As String temprint,odd |
|||
While x<>"" |
|||
temprint="" |
|||
odd="" |
|||
If not IsEven(x) Then |
|||
temprint=" *" |
|||
odd=" <-- odd" |
|||
ans=Accumulate(y,ans) |
|||
End If |
|||
Print x;odd;tab(30);y;temprint |
|||
x=Half(x) |
|||
y= Double_(y) |
|||
Wend |
|||
Return ans |
|||
End Function |
|||
'================= Example ==================== |
|||
Print |
|||
Dim As String s1="17" |
|||
Dim As String s2="34" |
|||
Print "Half";tab(30);"Double * marks those accumulated" |
|||
print "Biggest";tab(30);"Smallest" |
|||
Print |
|||
Var ans= EthiopianMultiply(s1,s2) |
|||
Print |
|||
Print |
|||
Print "Final answer" |
|||
Print " ";ans |
|||
print "Float check" |
|||
Print Val(s1)*Val(s2) |
|||
Sleep |
|||
</syntaxhighlight>note: algorithm uses strings instead of integers |
|||
{{out}} |
|||
<pre>Half Double * marks those accumulated |
|||
Biggest Smallest |
|||
34 17 |
|||
17 <-- odd 34 * |
|||
8 68 |
|||
4 136 |
|||
2 272 |
|||
1 <-- odd 544 * |
|||
Final answer |
|||
578 |
|||
Float check |
|||
578</pre> |
|||
==={{header|GW-BASIC}}=== |
|||
{{works with|BASICA}} |
|||
<syntaxhighlight lang="gwbasic">10 REM Ethiopian multiplication |
|||
20 DEF FNE(A%) = (A% + 1) MOD 2 |
|||
30 DEF FNH(A%) = A% \ 2 |
|||
40 DEF FND(A%) = 2 * A% |
|||
50 X% = 17: Y% = 34: TOT% = 0 |
|||
60 WHILE X% >= 1 |
|||
70 PRINT USING "###### "; X%; |
|||
80 IF FNE(X%)=0 THEN TOT% = TOT% + Y%: PRINT USING "###### "; Y% ELSE PRINT |
|||
90 X% = FNH(X%): Y% = FND(Y%) |
|||
100 WEND |
|||
110 PRINT USING "= ######"; TOT% |
|||
120 END</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
17 34 |
|||
8 |
|||
4 |
|||
2 |
|||
1 544 |
|||
= 578 |
|||
</pre> |
|||
==={{header|Liberty BASIC}}=== |
|||
<syntaxhighlight lang="lb">x = 17 |
|||
y = 34 |
|||
msg$ = str$(x) + " * " + str$(y) + " = " |
|||
Print str$(x) + " " + str$(y) |
|||
'In this routine we will not worry about discarding the right hand value whos left hand partner is even; |
|||
'we will just not add it to our product. |
|||
Do Until x < 2 |
|||
If Not(isEven(x)) Then |
|||
product = (product + y) |
|||
End If |
|||
x = halveInt(x) |
|||
y = doubleInt(y) |
|||
Print str$(x) + " " + str$(y) |
|||
Loop |
|||
product = (product + y) |
|||
If (x < 0) Then product = (product * -1) |
|||
Print msg$ + str$(product) |
|||
Function isEven(num) |
|||
isEven = Abs(Not(num Mod 2)) |
|||
End Function |
|||
Function halveInt(num) |
|||
halveInt = Int(num/ 2) |
|||
End Function |
|||
Function doubleInt(num) |
|||
doubleInt = Int(num * 2) |
|||
End Function</syntaxhighlight> |
|||
==={{header|Microsoft Small Basic}}=== |
|||
<syntaxhighlight lang="microsoftsmallbasic">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)</syntaxhighlight> |
|||
==={{header|Minimal BASIC}}=== |
|||
<syntaxhighlight lang="gwbasic">10 REM Ethiopian multiplication |
|||
20 DEF FND(A) = 2*A |
|||
30 DEF FNH(A) = INT(A/2) |
|||
40 DEF FNE(A) = A-INT(A/2)*2-1 |
|||
50 LET X = 17 |
|||
60 LET Y = 34 |
|||
70 LET T = 0 |
|||
80 IF X < 1 THEN 170 |
|||
90 IF FNE(X) <> 0 THEN 130 |
|||
100 LET T = T+Y |
|||
110 PRINT X; TAB(9); Y; "(kept)" |
|||
120 GOTO 140 |
|||
130 PRINT X; TAB(9); Y |
|||
140 LET X = FNH(X) |
|||
150 LET Y = FND(Y) |
|||
160 GOTO 80 |
|||
170 PRINT "------------" |
|||
180 PRINT "= "; TAB(9); T; "(sum of kept second vals)" |
|||
190 END</syntaxhighlight> |
|||
==={{header|MSX Basic}}=== |
|||
{{works with|MSX BASIC|any}} |
|||
Same code as [[#Nascom_BASIC|Nascom BASIC]] |
|||
==={{header|Nascom BASIC}}=== |
|||
{{trans|Modula-2}} |
|||
{{works with|Nascom ROM BASIC|4.7}} |
|||
<syntaxhighlight lang="basic">10 REM Ethiopian multiplication |
|||
20 DEF FND(A)=2*A |
|||
30 DEF FNH(A)=INT(A/2) |
|||
40 DEF FNE(A)=A-INT(A/2)*2-1 |
|||
50 X=17 |
|||
60 Y=34 |
|||
70 TT=0 |
|||
80 IF X<1 THEN 150 |
|||
90 NR=X:GOSUB 1000:PRINT " "; |
|||
100 IF FNE(X)=0 THEN TT=TT+Y:NR=Y:GOSUB 1000 |
|||
110 PRINT |
|||
120 X=FNH(X) |
|||
130 Y=FND(Y) |
|||
140 GOTO 80 |
|||
150 PRINT "= "; |
|||
160 NR=TT:GOSUB 1000:PRINT |
|||
170 END |
|||
995 REM Print NR in 9 fields |
|||
1000 S$=STR$(NR) |
|||
1010 PRINT SPC(9-LEN(S$));S$; |
|||
1020 RETURN</syntaxhighlight> |
|||
{{out}} |
|||
<pre> 17 34 |
|||
8 |
|||
4 |
|||
2 |
|||
1 544 |
|||
= 578</pre> |
|||
==={{header|PureBasic}}=== |
|||
<syntaxhighlight lang="purebasic">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</syntaxhighlight> |
|||
{{out}} |
|||
Ethiopian multiplication of 17 and 34 ... equals 578 |
|||
It became apparent that according to the way the Ethiopian method is described above it can't produce a correct result if the first multiplicand (the one being repeatedly halved) is negative. I've addressed that in this variation. If the first multiplicand is negative then the resulting sum (which may already be positive or negative) is negated. |
|||
<syntaxhighlight lang="purebasic">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</syntaxhighlight> |
|||
{{out}} |
|||
<pre> Ethiopian multiplication of 17 and 34 ... equals 578 |
|||
Ethiopian multiplication of -17 and 34 ... equals -578 |
|||
Ethiopian multiplication of -17 and -34 ... equals 578</pre> |
|||
==={{header|QB64}}=== |
|||
<syntaxhighlight lang="qbasic">PRINT multiply(17, 34) |
|||
SUB twice (n AS LONG) |
|||
n = n * 2 |
|||
END SUB |
|||
SUB halve (n AS LONG) |
|||
n = n / 2 |
|||
END SUB |
|||
FUNCTION odd%% (n AS LONG) |
|||
odd%% = (n AND 1) * -1 |
|||
END FUNCTION |
|||
FUNCTION multiply& (a AS LONG, b AS LONG) |
|||
DIM AS LONG result, multiplicand, multiplier |
|||
multiplicand = a |
|||
multiplier = b |
|||
WHILE multiplicand <> 0 |
|||
IF odd(multiplicand) THEN result = result + multiplier |
|||
halve multiplicand |
|||
twice multiplier |
|||
WEND |
|||
multiply& = result |
|||
END FUNCTION</syntaxhighlight> |
|||
{{out}} |
|||
<pre>578</pre> |
|||
==={{header|Sinclair ZX81 BASIC}}=== |
|||
Requires at least 2k of RAM. The specification is emphatic about wanting named functions: in a language where user-defined functions do not exist, the best we can do is to use subroutines and assign their line numbers to variables. This allows us to <code>GOSUB HALVE</code> instead of having to <code>GOSUB 320</code>. (It would however be more idiomatic to avoid using subroutines at all, for simple operations like these, and to refer to them by line number if they were used.) |
|||
<syntaxhighlight lang="basic"> 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</syntaxhighlight> |
|||
{{in}} |
|||
<pre>17 |
|||
34</pre> |
|||
{{out}} |
|||
<pre>17 34 |
|||
8 |
|||
4 |
|||
2 |
|||
1 544 |
|||
578</pre> |
|||
==={{header|Tiny BASIC}}=== |
|||
<syntaxhighlight lang="tinybasic"> |
|||
REM Ethiopian multiplication |
|||
LET X=17 |
|||
LET Y=34 |
|||
LET T=0 |
|||
10 IF X<1 THEN GOTO 40 |
|||
LET A=X |
|||
GOSUB 400 |
|||
IF E=0 THEN GOTO 20 |
|||
LET T=T+Y |
|||
PRINT X,", ",Y, " (kept)" |
|||
GOTO 30 |
|||
20 PRINT X,", ",Y |
|||
30 GOSUB 300 |
|||
LET X=A |
|||
LET A=Y |
|||
GOSUB 200 |
|||
LET Y=A |
|||
GOTO 10 |
|||
40 PRINT "------------" |
|||
PRINT "= ",T," (sum of kept second vals)" |
|||
END |
|||
REM Subroutines are required, though |
|||
REM they complicate the code |
|||
REM -- Double -- |
|||
REM A - param. |
|||
200 LET A=2*A |
|||
RETURN |
|||
REM -- Halve -- |
|||
REM A - param. |
|||
300 LET A=A/2 |
|||
RETURN |
|||
REM -- Is even -- |
|||
REM A - param.; E - result (0 - false) |
|||
400 LET E=A-(A/2)*2 |
|||
RETURN</syntaxhighlight> |
|||
{{out}} |
|||
<pre>17, 34 (kept) |
|||
8, 68 |
|||
4, 136 |
|||
2, 272 |
|||
1, 544 (kept) |
|||
------------ |
|||
= 578 (sum of kept second vals)</pre> |
|||
==={{header|True BASIC}}=== |
|||
A translation of BBC BASIC. True BASIC does not have Boolean operations built-in. |
|||
<syntaxhighlight lang="basic">!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</syntaxhighlight> |
|||
==={{header|XBasic}}=== |
|||
{{trans|Modula-2}} |
|||
{{works with|Windows XBasic}} |
|||
<syntaxhighlight lang="xbasic">' Ethiopian multiplication |
|||
PROGRAM "ethmult" |
|||
VERSION "0.0000" |
|||
DECLARE FUNCTION Entry() |
|||
INTERNAL FUNCTION Double(@a&&) |
|||
INTERNAL FUNCTION Halve(@a&&) |
|||
INTERNAL FUNCTION IsEven(a&&) |
|||
FUNCTION Entry() |
|||
x&& = 17 |
|||
y&& = 34 |
|||
tot&& = 0 |
|||
DO WHILE x&& >= 1 |
|||
PRINT FORMAT$("#########", x&&); |
|||
PRINT " "; |
|||
IFF IsEven(x&&) THEN |
|||
tot&& = tot&& + y&& |
|||
PRINT FORMAT$("#########", y&&); |
|||
END IF |
|||
PRINT |
|||
Halve(@x&&) |
|||
Double(@y&&) |
|||
LOOP |
|||
PRINT "= "; |
|||
PRINT FORMAT$("#########", tot&&); |
|||
PRINT |
|||
END FUNCTION |
|||
FUNCTION Double(a&&) |
|||
a&& = 2 * a&& |
|||
END FUNCTION |
|||
FUNCTION Halve(a&&) |
|||
a&& = a&& / 2 |
|||
END FUNCTION |
|||
FUNCTION IsEven(a&&) |
|||
RETURN a&& MOD 2 = 0 |
|||
END FUNCTION |
|||
END PROGRAM</syntaxhighlight> |
|||
{{out}} |
|||
<pre> 17 34 |
|||
8 |
|||
4 |
|||
2 |
|||
1 544 |
|||
= 578</pre> |
|||
==={{header|Yabasic}}=== |
|||
<syntaxhighlight lang="vbnet">outP = 0 |
|||
x = 17 |
|||
y = 34 |
|||
do |
|||
print x, chr$(09); |
|||
if not (isEven(x)) then |
|||
outP = outP + y |
|||
print y |
|||
else |
|||
print |
|||
fi |
|||
if x < 2 break |
|||
x = half(x) |
|||
y = doub(y) |
|||
loop |
|||
print "=", chr$(09), outP |
|||
end |
|||
sub doub (a) |
|||
return a * 2 |
|||
end sub |
|||
sub half (a) |
|||
return int(a / 2) |
|||
end sub |
|||
sub isEven (a) |
|||
return mod(a, 2) - 1 |
|||
end sub</syntaxhighlight> |
|||
=={{header|Batch File}}== |
|||
<syntaxhighlight lang="dos"> |
|||
@echo off |
|||
:: Pick 2 random, non-zero, 2-digit numbers to send to :_main |
|||
set /a param1=%random% %% 98 + 1 |
|||
set /a param2=%random% %% 98 + 1 |
|||
call:_main %param1% %param2% |
|||
pause>nul |
|||
exit /b |
|||
:: This is the main function that outputs the answer in the form of "%1 * %2 = %answer%" |
|||
:_main |
|||
setlocal enabledelayedexpansion |
|||
set l0=%1 |
|||
set r0=%2 |
|||
set leftcount=1 |
|||
set lefttempcount=0 |
|||
set rightcount=1 |
|||
set righttempcount=0 |
|||
:: Creates an array ("l[]") with the :_halve function. %l0% is the initial left number parsed |
|||
:: This section will loop until the most recent member of "l[]" is equal to 0 |
|||
:left |
|||
set /a lefttempcount=%leftcount%-1 |
|||
if !l%lefttempcount%!==1 goto right |
|||
call:_halve !l%lefttempcount%! |
|||
set l%leftcount%=%errorlevel% |
|||
set /a leftcount+=1 |
|||
goto left |
|||
:: Creates an array ("r[]") with the :_double function, %r0% is the initial right number parsed |
|||
:: This section will loop until it has the same amount of entries as "l[]" |
|||
:right |
|||
set /a righttempcount=%rightcount%-1 |
|||
if %rightcount%==%leftcount% goto both |
|||
call:_double !r%righttempcount%! |
|||
set r%rightcount%=%errorlevel% |
|||
set /a rightcount+=1 |
|||
goto right |
|||
:both |
|||
:: Creates an boolean array ("e[]") corresponding with whether or not the respective "l[]" entry is even |
|||
for /l %%i in (0,1,%lefttempcount%) do ( |
|||
call:_even !l%%i! |
|||
set e%%i=!errorlevel! |
|||
) |
|||
:: Adds up all entries of "r[]" based on the value of "e[]", respectively |
|||
set answer=0 |
|||
for /l %%i in (0,1,%lefttempcount%) do ( |
|||
if !e%%i!==1 ( |
|||
set /a answer+=!r%%i! |
|||
:: Everything from this----------------------------- |
|||
set iseven%%i=KEEP |
|||
) else ( |
|||
set iseven%%i=STRIKE |
|||
) |
|||
echo L: !l%%i! R: !r%%i! - !iseven%%i! |
|||
:: To this, is for cosmetics and is optional-------- |
|||
) |
|||
echo %l0% * %r0% = %answer% |
|||
exit /b |
|||
:: These are the three functions being used. The output of these functions are expressed in the errorlevel that they return |
|||
:_halve |
|||
setlocal |
|||
set /a temp=%1/2 |
|||
exit /b %temp% |
|||
:_double |
|||
setlocal |
|||
set /a temp=%1*2 |
|||
exit /b %temp% |
|||
:_even |
|||
setlocal |
|||
set int=%1 |
|||
set /a modint=%int% %% 2 |
|||
exit /b %modint% |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
L: 17 R: 34 - KEEP |
|||
L: 8 R: 68 - STRIKE |
|||
L: 4 R: 136 - STRIKE |
|||
L: 2 R: 272 - STRIKE |
|||
L: 1 R: 544 - KEEP |
|||
17 * 34 = 578 |
|||
</pre> |
|||
=={{header|BCPL}}== |
|||
<syntaxhighlight lang="bcpl">get "libhdr" |
|||
let halve(i) = i>>1 |
|||
and double(i) = i<<1 |
|||
and even(i) = (i&1) = 0 |
|||
let emul(x, y) = emulr(x, y, 0) |
|||
and emulr(x, y, ac) = |
|||
x=0 -> ac, |
|||
emulr(halve(x), double(y), even(x) -> ac, ac + y) |
|||
let start() be writef("%N*N", emul(17, 34))</syntaxhighlight> |
|||
{{out}} |
|||
<pre>578</pre> |
|||
=={{header|Bracmat}}== |
|||
<syntaxhighlight lang="bracmat">( (halve=.div$(!arg.2)) |
|||
& (double=.2*!arg) |
|||
& (isEven=.mod$(!arg.2):0) |
|||
& ( mul |
|||
= a b as bs newbs result |
|||
. !arg:(?as.?bs) |
|||
& whl |
|||
' ( !as:? (%@:~1:?a) |
|||
& !as halve$!a:?as |
|||
& !bs:? %@?b |
|||
& !bs double$!b:?bs |
|||
) |
|||
& :?newbs |
|||
& whl |
|||
' ( !as:%@?a ?as |
|||
& !bs:%@?b ?bs |
|||
& (isEven$!a|!newbs !b:?newbs) |
|||
) |
|||
& 0:?result |
|||
& whl |
|||
' (!newbs:%@?b ?newbs&!b+!result:?result) |
|||
& !result |
|||
) |
|||
& out$(mul$(17.34)) |
|||
);</syntaxhighlight> |
|||
Output |
|||
<pre>578</pre> |
|||
=={{header|BQN}}== |
|||
<syntaxhighlight lang="bqn">Double ← 2⊸× |
|||
Halve ← ⌊÷⟜2 |
|||
Odd ← 2⊸| |
|||
EMul ← { |
|||
times ← ↕⌈2⋆⁼𝕨 |
|||
+´(Odd Halve⍟times 𝕨)/Double⍟times 𝕩 |
|||
} |
|||
17 EMul 34</syntaxhighlight><syntaxhighlight lang="text">578</syntaxhighlight> |
|||
To avoid using a while loop, the iteration count is computed beforehand. |
|||
=={{header|C}}== |
=={{header|C}}== |
||
< |
<syntaxhighlight lang="c">#include <stdio.h> |
||
#include <stdbool.h> |
#include <stdbool.h> |
||
Line 246: | Line 1,919: | ||
printf("%d\n", ethiopian(17, 34, true)); |
printf("%d\n", ethiopian(17, 34, true)); |
||
return 0; |
return 0; |
||
}</ |
}</syntaxhighlight> |
||
=={{header|C sharp|C#}}== |
|||
{{works with|c sharp|C#|3+}}<br> |
|||
{{libheader|System.Linq}}<br> |
|||
<syntaxhighlight lang="csharp"> |
|||
using System; |
|||
using System.Linq; |
|||
namespace RosettaCode.Tasks |
|||
{ |
|||
public static class EthiopianMultiplication_Task |
|||
{ |
|||
public static void Test ( ) |
|||
{ |
|||
Console.WriteLine ( "Ethiopian Multiplication" ); |
|||
int A = 17, B = 34; |
|||
Console.WriteLine ( "Recursion: {0}*{1}={2}", A, B, EM_Recursion ( A, B ) ); |
|||
Console.WriteLine ( "Linq: {0}*{1}={2}", A, B, EM_Linq ( A, B ) ); |
|||
Console.WriteLine ( "Loop: {0}*{1}={2}", A, B, EM_Loop ( A, B ) ); |
|||
Console.WriteLine ( ); |
|||
} |
|||
public static int Halve ( this int p_Number ) |
|||
{ |
|||
return p_Number >> 1; |
|||
} |
|||
public static int Double ( this int p_Number ) |
|||
{ |
|||
return p_Number << 1; |
|||
} |
|||
public static bool IsEven ( this int p_Number ) |
|||
{ |
|||
return ( p_Number % 2 ) == 0; |
|||
} |
|||
public static int EM_Recursion ( int p_NumberA, int p_NumberB ) |
|||
{ |
|||
// Anchor Point, Recurse to find the next row Sum it with the second number according to the rules |
|||
return p_NumberA == 1 ? p_NumberB : EM_Recursion ( p_NumberA.Halve ( ), p_NumberB.Double ( ) ) + ( p_NumberA.IsEven ( ) ? 0 : p_NumberB ); |
|||
} |
|||
public static int EM_Linq ( int p_NumberA, int p_NumberB ) |
|||
{ |
|||
// Creating a range from 1 to x where x the number of times p_NumberA can be halved. |
|||
// This will be 2^x where 2^x <= p_NumberA. Basically, ln(p_NumberA)/ln(2). |
|||
return Enumerable.Range ( 1, Convert.ToInt32 ( Math.Log ( p_NumberA, Math.E ) / Math.Log ( 2, Math.E ) ) + 1 ) |
|||
// For every item (Y) in that range, create a new list, comprising the pair (p_NumberA,p_NumberB) Y times. |
|||
.Select ( ( item ) => Enumerable.Repeat ( new { Col1 = p_NumberA, Col2 = p_NumberB }, item ) |
|||
// The aggregate method iterates over every value in the target list, passing the accumulated value and the current item's value. |
|||
.Aggregate ( ( agg_pair, orig_pair ) => new { Col1 = agg_pair.Col1.Halve ( ), Col2 = agg_pair.Col2.Double ( ) } ) ) |
|||
// Remove all even items |
|||
.Where ( pair => !pair.Col1.IsEven ( ) ) |
|||
// And sum! |
|||
.Sum ( pair => pair.Col2 ); |
|||
} |
|||
public static int EM_Loop ( int p_NumberA, int p_NumberB ) |
|||
{ |
|||
int RetVal = 0; |
|||
while ( p_NumberA >= 1 ) |
|||
{ |
|||
RetVal += p_NumberA.IsEven ( ) ? 0 : p_NumberB; |
|||
p_NumberA = p_NumberA.Halve ( ); |
|||
p_NumberB = p_NumberB.Double ( ); |
|||
} |
|||
return RetVal; |
|||
} |
|||
} |
|||
}</syntaxhighlight> |
|||
=={{header|C++}}== |
=={{header|C++}}== |
||
Line 254: | Line 1,995: | ||
Here is such an implementation without tutor, since there is no mechanism in C++ to output |
Here is such an implementation without tutor, since there is no mechanism in C++ to output |
||
messages during program compilation. |
messages during program compilation. |
||
<syntaxhighlight lang="cpp">template<int N> |
|||
<lang cpp> |
|||
template<int N> |
|||
struct Half |
struct Half |
||
{ |
{ |
||
Line 290: | Line 2,030: | ||
struct Loop |
struct Loop |
||
{ |
{ |
||
enum { Result = Loop<Half<Plier>::Result, Double<Plicand>::Result, |
enum { Result = Loop<Half<Plier>::Result, Double<Plicand>::Result, |
||
AddIfNot<IsEven<Plier>::Result, Plicand, RunningTotal >::Result >::Result }; |
|||
}; |
}; |
||
template<int Plicand, int RunningTotal> |
template<int Plicand, int RunningTotal> |
||
Line 307: | Line 2,048: | ||
std::cout << EthiopianMultiplication<17, 54>::Result << std::endl; |
std::cout << EthiopianMultiplication<17, 54>::Result << std::endl; |
||
return 0; |
return 0; |
||
}</syntaxhighlight> |
|||
} |
|||
</lang> |
|||
=={{header|Clojure}}== |
|||
<syntaxhighlight lang="lisp">(defn halve [n] |
|||
(bit-shift-right n 1)) |
|||
(defn twice [n] ; 'double' is taken |
|||
(bit-shift-left n 1)) |
|||
(defn even [n] ; 'even?' is the standard fn |
|||
(zero? (bit-and n 1))) |
|||
(defn emult [x y] |
|||
(reduce + |
|||
(map second |
|||
(filter #(not (even (first %))) ; a.k.a. 'odd?' |
|||
(take-while #(pos? (first %)) |
|||
(map vector |
|||
(iterate halve x) |
|||
(iterate twice y))))))) |
|||
(defn emult2 [x y] |
|||
(loop [a x, b y, r 0] |
|||
(if (= a 1) |
|||
(+ r b) |
|||
(if (even a) |
|||
(recur (halve a) (twice b) r) |
|||
(recur (halve a) (twice b) (+ r b))))))</syntaxhighlight> |
|||
=={{header|CLU}}== |
|||
<syntaxhighlight lang="clu">halve = proc (n: int) returns (int) |
|||
return(n/2) |
|||
end halve |
|||
double = proc (n: int) returns (int) |
|||
return(n*2) |
|||
end double |
|||
even = proc (n: int) returns (bool) |
|||
return(n//2 = 0) |
|||
end even |
|||
e_mul = proc (a, b: int) returns (int) |
|||
total: int := 0 |
|||
while (a > 0) do |
|||
if ~even(a) then total := total + b end |
|||
a := halve(a) |
|||
b := double(b) |
|||
end |
|||
return(total) |
|||
end e_mul |
|||
start_up = proc () |
|||
po: stream := stream$primary_output() |
|||
stream$putl(po, int$unparse(e_mul(17, 34))) |
|||
end start_up</syntaxhighlight> |
|||
{{out}} |
|||
<pre>578</pre> |
|||
=={{header|COBOL}}== |
|||
{{trans|Common Lisp}} |
|||
{{works with|COBOL|2002}} |
|||
{{works with|OpenCOBOL|1.1}} |
|||
In COBOL, ''double'' is a reserved word, so the doubling functions is named ''twice'', instead. |
|||
<syntaxhighlight lang="cobol"> *>* Ethiopian multiplication |
|||
IDENTIFICATION DIVISION. |
|||
PROGRAM-ID. ethiopian-multiplication. |
|||
DATA DIVISION. |
|||
LOCAL-STORAGE SECTION. |
|||
01 l PICTURE 9(10) VALUE 17. |
|||
01 r PICTURE 9(10) VALUE 34. |
|||
01 ethiopian-multiply PICTURE 9(20). |
|||
01 product PICTURE 9(20). |
|||
PROCEDURE DIVISION. |
|||
CALL "ethiopian-multiply" USING |
|||
BY CONTENT l, BY CONTENT r, |
|||
BY REFERENCE ethiopian-multiply |
|||
END-CALL |
|||
DISPLAY ethiopian-multiply END-DISPLAY |
|||
MULTIPLY l BY r GIVING product END-MULTIPLY |
|||
DISPLAY product END-DISPLAY |
|||
STOP RUN. |
|||
END PROGRAM ethiopian-multiplication. |
|||
IDENTIFICATION DIVISION. |
|||
PROGRAM-ID. ethiopian-multiply. |
|||
DATA DIVISION. |
|||
LOCAL-STORAGE SECTION. |
|||
01 evenp PICTURE 9. |
|||
88 even VALUE 1. |
|||
88 odd VALUE 0. |
|||
LINKAGE SECTION. |
|||
01 l PICTURE 9(10). |
|||
01 r PICTURE 9(10). |
|||
01 product PICTURE 9(20) VALUE ZERO. |
|||
PROCEDURE DIVISION using l, r, product. |
|||
MOVE ZEROES TO product |
|||
PERFORM UNTIL l EQUAL ZERO |
|||
CALL "evenp" USING |
|||
BY CONTENT l, |
|||
BY REFERENCE evenp |
|||
END-CALL |
|||
IF odd |
|||
ADD r TO product GIVING product END-ADD |
|||
END-IF |
|||
CALL "halve" USING |
|||
BY CONTENT l, |
|||
BY REFERENCE l |
|||
END-CALL |
|||
CALL "twice" USING |
|||
BY CONTENT r, |
|||
BY REFERENCE r |
|||
END-CALL |
|||
END-PERFORM |
|||
GOBACK. |
|||
END PROGRAM ethiopian-multiply. |
|||
IDENTIFICATION DIVISION. |
|||
PROGRAM-ID. halve. |
|||
DATA DIVISION. |
|||
LOCAL-STORAGE SECTION. |
|||
LINKAGE SECTION. |
|||
01 n PICTURE 9(10). |
|||
01 m PICTURE 9(10). |
|||
PROCEDURE DIVISION USING n, m. |
|||
DIVIDE n BY 2 GIVING m END-DIVIDE |
|||
GOBACK. |
|||
END PROGRAM halve. |
|||
IDENTIFICATION DIVISION. |
|||
PROGRAM-ID. twice. |
|||
DATA DIVISION. |
|||
LOCAL-STORAGE SECTION. |
|||
LINKAGE SECTION. |
|||
01 n PICTURE 9(10). |
|||
01 m PICTURE 9(10). |
|||
PROCEDURE DIVISION USING n, m. |
|||
MULTIPLY n by 2 GIVING m END-MULTIPLY |
|||
GOBACK. |
|||
END PROGRAM twice. |
|||
IDENTIFICATION DIVISION. |
|||
PROGRAM-ID. evenp. |
|||
DATA DIVISION. |
|||
LOCAL-STORAGE SECTION. |
|||
01 q PICTURE 9(10). |
|||
LINKAGE SECTION. |
|||
01 n PICTURE 9(10). |
|||
01 m PICTURE 9(1). |
|||
88 even VALUE 1. |
|||
88 odd VALUE 0. |
|||
PROCEDURE DIVISION USING n, m. |
|||
DIVIDE n BY 2 GIVING q REMAINDER m END-DIVIDE |
|||
SUBTRACT m FROM 1 GIVING m END-SUBTRACT |
|||
GOBACK. |
|||
END PROGRAM evenp.</syntaxhighlight> |
|||
=={{header|CoffeeScript}}== |
|||
<syntaxhighlight lang="coffeescript"> |
|||
halve = (n) -> Math.floor n / 2 |
|||
double = (n) -> n * 2 |
|||
is_even = (n) -> n % 2 == 0 |
|||
multiply = (a, b) -> |
|||
prod = 0 |
|||
while a > 0 |
|||
prod += b if !is_even a |
|||
a = halve a |
|||
b = double b |
|||
prod |
|||
# tests |
|||
do -> |
|||
for i in [0..100] |
|||
for j in [0..100] |
|||
throw Error("broken for #{i} * #{j}") if multiply(i,j) != i * j |
|||
</syntaxhighlight> |
|||
=== CoffeeScript "One-liner" === |
|||
ethiopian = (a, b, r=0) -> if a <= 0 then r else ethiopian a // 2, b * 2, if a % 2 then r + b else r |
|||
=={{header|ColdFusion}}== |
=={{header|ColdFusion}}== |
||
Version with as a function of functions: |
Version with as a function of functions: |
||
<syntaxhighlight lang="cfm"><cffunction name="double"> |
|||
<lang ColdFusion> |
|||
<cffunction name="double"> |
|||
<cfargument name="number" type="numeric" required="true"> |
<cfargument name="number" type="numeric" required="true"> |
||
<cfset answer = number * 2> |
<cfset answer = number * 2> |
||
Line 348: | Line 2,270: | ||
<cfoutput>#ethiopian(17,34)#</cfoutput> |
<cfoutput>#ethiopian(17,34)#</cfoutput></syntaxhighlight>Version with display pizza:<syntaxhighlight lang="cfm"><cfset Number_A = 17> |
||
</lang> |
|||
Version with display pizza: |
|||
<lang ColdFusion> |
|||
<cfset Number_A = 17> |
|||
<cfset Number_B = 34> |
<cfset Number_B = 34> |
||
<cfset Result = 0> |
<cfset Result = 0> |
||
Line 410: | Line 2,326: | ||
...equals #Result# |
...equals #Result# |
||
</cfoutput> |
</cfoutput></syntaxhighlight> |
||
Sample output:<pre> |
|||
</lang> |
|||
Sample output: |
|||
<pre> |
|||
Ethiopian multiplication of 17 and 34... |
Ethiopian multiplication of 17 and 34... |
||
17 34 Keep |
17 34 Keep |
||
Line 427: | Line 2,339: | ||
=={{header|Common Lisp}}== |
=={{header|Common Lisp}}== |
||
Common Lisp already has <code>evenp</code>, but all three of <code>halve</code>, <code>double</code>, and <code>even-p</code> are locally defined within <code>ethiopian-multiply</code>. (Note that the termination condition is <code>(zerop l)</code> because we terminate 'after' the iteration wherein the left column contains 1, and <code>(halve 1)</code> is 0.) |
Common Lisp already has <code>evenp</code>, but all three of <code>halve</code>, <code>double</code>, and <code>even-p</code> are locally defined within <code>ethiopian-multiply</code>. (Note that the termination condition is <code>(zerop l)</code> because we terminate 'after' the iteration wherein the left column contains 1, and <code>(halve 1)</code> is 0.)<syntaxhighlight lang="lisp">(defun ethiopian-multiply (l r) |
||
<lang lisp>(defun ethiopian-multiply (l r) |
|||
(flet ((halve (n) (floor n 2)) |
(flet ((halve (n) (floor n 2)) |
||
(double (n) (* n 2)) |
(double (n) (* n 2)) |
||
Line 436: | Line 2,346: | ||
(l l (halve l)) |
(l l (halve l)) |
||
(r r (double r))) |
(r r (double r))) |
||
((zerop l) product))))</ |
((zerop l) product))))</syntaxhighlight> |
||
=={{header|Craft Basic}}== |
|||
<syntaxhighlight lang="basic">let x = 17 |
|||
let y = 34 |
|||
let s = 0 |
|||
do |
|||
if x < 1 then |
|||
break |
|||
endif |
|||
if s = 1 then |
|||
print x |
|||
endif |
|||
if s = 0 then |
|||
let s = 1 |
|||
endif |
|||
let a = x |
|||
let e = a % 2 |
|||
let e = 1 - e |
|||
if e = 0 then |
|||
let t = t + y |
|||
print x, " ", y |
|||
endif |
|||
let a = x |
|||
let a = int(a / 2) |
|||
let x = a |
|||
let a = y |
|||
let a = 2 * a |
|||
let y = a |
|||
loop x >= 1 |
|||
print "=" |
|||
print t</syntaxhighlight> |
|||
{{out| Output}}<pre>17 34 |
|||
8 |
|||
4 |
|||
2 |
|||
1 |
|||
1 544 |
|||
= |
|||
578</pre> |
|||
=={{header|D}}== |
=={{header|D}}== |
||
<syntaxhighlight lang="d">int ethiopian(int n1, int n2) pure nothrow @nogc |
|||
<lang d> |
|||
in { |
|||
import std.stdio; |
|||
assert(n1 >= 0, "Multiplier can't be negative"); |
|||
int dub(int num) { return num << 1; } |
|||
} body { |
|||
int halve(int num) { return num >> 1; } |
|||
static enum doubleNum = (in int n) pure nothrow @nogc => n * 2; |
|||
bool isEven(int num) { return !(num & 1); } |
|||
static enum halveNum = (in int n) pure nothrow @nogc => n / 2; |
|||
static enum isEven = (in int n) pure nothrow @nogc => !(n & 1); |
|||
int result; |
|||
while (n1 >= 1) { |
|||
if (!isEven(n1)) |
|||
while(n1 >= 1) { |
|||
result += n2; |
|||
n1 = |
n1 = halveNum(n1); |
||
n2 = |
n2 = doubleNum(n2); |
||
} |
|||
return ret; |
|||
} |
|||
return result; |
|||
int main() { |
|||
} unittest { |
|||
writefln("17 ethiopian 34 is %d", ethiopian(17, 34)); |
|||
assert(ethiopian(77, 54) == 77 * 54); |
|||
return 0; |
|||
assert(ethiopian(8, 923) == 8 * 923); |
|||
assert(ethiopian(64, -4) == 64 * -4); |
|||
} |
} |
||
</lang> |
|||
void main() { |
|||
import std.stdio; |
|||
writeln("17 ethiopian 34 is ", ethiopian(17, 34)); |
|||
}</syntaxhighlight>{{out}} |
|||
17 ethiopian 34 is 578 |
|||
=={{header|dc}}== |
|||
<syntaxhighlight lang="dc">0k [ Make sure we're doing integer division ]sx |
|||
[ 2 / ] sH [ Define "halve" function in register H ]sx |
|||
[ 2 * ] sD [ Define "double" function in register D ]sx |
|||
[ 2 % 1 r - ] sE [ Define "even?" function in register E ]sx |
|||
[ Entry into the main Ethiopian multiplication function is register M ]sx |
|||
[ Keeps running value for the product in register p ]sx |
|||
[ 0 sp lLx lp ] sM |
|||
[ The body of the main loop is in register L ]sx |
|||
[ |
|||
sb sa [ First thing we do is cheat and store the parameters in |
|||
registers, which is safe because the only recursion is of |
|||
the tail variety. This avoids tricky stack |
|||
manipulations, which dc doesn't have good support for |
|||
(unlike, say, Forth). ]sx |
|||
la lEx sr [ r = even?(a) ]sx |
|||
lr 0 =S [ if r = 0 then call s]sx |
|||
la lHx d [ a = halve(a)]sx |
|||
lb lDx [ b = double(b)]sx |
|||
r 0 !=L [ if a !=0 then recurse ] |
|||
] sL |
|||
[ Utility macro that just adds the current value of b to the total in p ]sx |
|||
[ lp lb + sp ]sS |
|||
[ Demo by multiplying 17 and 34 ]sx |
|||
17 34 lMx p</syntaxhighlight> |
|||
{{out}} |
|||
578 |
|||
=={{header|Delphi}}== |
|||
See [https://rosettacode.org/wiki/Ethiopian_multiplication#Pascal Pascal]. |
|||
=={{header|Draco}}== |
|||
<syntaxhighlight lang="draco">proc nonrec halve(word n) word: n >> 1 corp |
|||
proc nonrec double(word n) word: n << 1 corp |
|||
proc nonrec even(word n) bool: n & 1 = 0 corp |
|||
proc nonrec emul(word a, b) word: |
|||
word total; |
|||
total := 0; |
|||
while a > 0 do |
|||
if not even(a) then total := total + b fi; |
|||
a := halve(a); |
|||
b := double(b) |
|||
od; |
|||
total |
|||
corp |
|||
proc nonrec main() void: writeln(emul(17, 34)) corp</syntaxhighlight> |
|||
{{out}} |
|||
<pre>578</pre> |
|||
=={{header|E}}== |
=={{header|E}}== |
||
< |
<syntaxhighlight lang="e">def halve(&x) { x //= 2 } |
||
def double(&x) { x *= 2 } |
def double(&x) { x *= 2 } |
||
def even(x) { return x %% 2 <=> 0 } |
def even(x) { return x %% 2 <=> 0 } |
||
Line 474: | Line 2,504: | ||
} |
} |
||
return ab |
return ab |
||
}</ |
}</syntaxhighlight> |
||
=={{header|EasyLang}}== |
|||
<syntaxhighlight lang=text> |
|||
func mult x y . |
|||
while x >= 1 |
|||
if x mod 2 <> 0 |
|||
tot += y |
|||
. |
|||
x = x div 2 |
|||
y *= 2 |
|||
. |
|||
return tot |
|||
. |
|||
print mult 17 34 |
|||
</syntaxhighlight> |
|||
=={{header|ed}}== |
|||
<syntaxhighlight lang="sed"> |
|||
H |
|||
,p |
|||
# decimal -> unary |
|||
g/[^0-9]\{1,\}/s///g |
|||
g/^0\{1,\}\([0-9]\)/s//\1/ |
|||
g/^9\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiiii/ |
|||
g/^8\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiii/ |
|||
g/^7\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiii/ |
|||
g/^6\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiii/ |
|||
g/^5\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiii/ |
|||
g/^4\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiii/ |
|||
g/^3\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iii/ |
|||
g/^2\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2ii/ |
|||
g/^1\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2i/ |
|||
g/^0\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2/ |
|||
g/^9\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiiii/ |
|||
g/^8\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiii/ |
|||
g/^7\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiii/ |
|||
g/^6\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiii/ |
|||
g/^5\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiii/ |
|||
g/^4\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiii/ |
|||
g/^3\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iii/ |
|||
g/^2\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2ii/ |
|||
g/^1\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2i/ |
|||
g/^0\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2/ |
|||
g/^9\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiiii/ |
|||
g/^8\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiii/ |
|||
g/^7\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiii/ |
|||
g/^6\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiii/ |
|||
g/^5\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiii/ |
|||
g/^4\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiii/ |
|||
g/^3\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iii/ |
|||
g/^2\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2ii/ |
|||
g/^1\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2i/ |
|||
g/^0\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2/ |
|||
g/^9\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiiii/ |
|||
g/^8\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiii/ |
|||
g/^7\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiii/ |
|||
g/^6\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiii/ |
|||
g/^5\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiii/ |
|||
g/^4\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiii/ |
|||
g/^3\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iii/ |
|||
g/^2\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2ii/ |
|||
g/^1\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2i/ |
|||
g/^0\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2/ |
|||
g/^9\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiiii/ |
|||
g/^8\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiii/ |
|||
g/^7\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiii/ |
|||
g/^6\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiii/ |
|||
g/^5\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiii/ |
|||
g/^4\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiii/ |
|||
g/^3\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iii/ |
|||
g/^2\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2ii/ |
|||
g/^1\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2i/ |
|||
g/^0\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2/ |
|||
# actual logic |
|||
1s/$/ / |
|||
,j |
|||
y |
|||
x |
|||
# Repeating the loop 10 times to be sure. |
|||
# Covers up to 1024 numbers. |
|||
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\ |
|||
y\ |
|||
x |
|||
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\ |
|||
y\ |
|||
x |
|||
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\ |
|||
y\ |
|||
x |
|||
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\ |
|||
y\ |
|||
x |
|||
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\ |
|||
y\ |
|||
x |
|||
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\ |
|||
y\ |
|||
x |
|||
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\ |
|||
y\ |
|||
x |
|||
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\ |
|||
y\ |
|||
x |
|||
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\ |
|||
y\ |
|||
x |
|||
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\ |
|||
y\ |
|||
x |
|||
$d |
|||
g/^\(i\{2\}\)*\>/d |
|||
g/^i* \(i*\)/s//\1/ |
|||
,j |
|||
# unary -> decimal (up to 10^10) |
|||
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/ |
|||
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/ |
|||
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/ |
|||
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/ |
|||
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/ |
|||
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/ |
|||
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/ |
|||
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/ |
|||
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/ |
|||
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/ |
|||
g/i/s/[ ]$/ 0 /g |
|||
g/i/s/[ ][ ]/ 0 /g |
|||
g/i/s/[ ][ ]/ 0 /g |
|||
g/i/s/[ ]iiiiiiiii\>/ 9 /g |
|||
g/i/s/[ ]iiiiiiii\>/ 8 /g |
|||
g/i/s/[ ]iiiiiii\>/ 7 /g |
|||
g/i/s/[ ]iiiiii\>/ 6 /g |
|||
g/i/s/[ ]iiiii\>/ 5 /g |
|||
g/i/s/[ ]iiii\>/ 4 /g |
|||
g/i/s/[ ]iii\>/ 3 /g |
|||
g/i/s/[ ]ii\>/ 2 /g |
|||
g/i/s/[ ]i\>/ 1 /g |
|||
g/[ ]/s///g |
|||
g/^0\{1,\}\([0-9]\)/s//\1/ |
|||
p |
|||
Q |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre>$ ed -s mul.input < ethiopian-mul.ed |
|||
Newline appended |
|||
17 |
|||
34 |
|||
578</pre> |
|||
=={{header|Eiffel}}== |
|||
<syntaxhighlight lang="eiffel"> |
|||
class |
|||
APPLICATION |
|||
create |
|||
make |
|||
feature {NONE} |
|||
make |
|||
do |
|||
io.put_integer (ethiopian_multiplication (17, 34)) |
|||
end |
|||
ethiopian_multiplication (a, b: INTEGER): INTEGER |
|||
-- Product of 'a' and 'b'. |
|||
require |
|||
a_positive: a > 0 |
|||
b_positive: b > 0 |
|||
local |
|||
x, y: INTEGER |
|||
do |
|||
x := a |
|||
y := b |
|||
from |
|||
until |
|||
x <= 0 |
|||
loop |
|||
if not is_even_int (x) then |
|||
Result := Result + y |
|||
end |
|||
x := halve_int (x) |
|||
y := double_int (y) |
|||
end |
|||
ensure |
|||
Result_correct: Result = a * b |
|||
end |
|||
feature {NONE} |
|||
double_int (n: INTEGER): INTEGER |
|||
--Two times 'n'. |
|||
do |
|||
Result := n * 2 |
|||
end |
|||
halve_int (n: INTEGER): INTEGER |
|||
--'n' divided by two. |
|||
do |
|||
Result := n // 2 |
|||
end |
|||
is_even_int (n: INTEGER): BOOLEAN |
|||
--Is 'n' an even integer? |
|||
do |
|||
Result := n \\ 2 = 0 |
|||
end |
|||
end |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
578 |
|||
</pre> |
|||
=={{header|Ela}}== |
|||
Translation of Haskell: |
|||
<syntaxhighlight lang="ela">open list number |
|||
halve x = x `div` 2 |
|||
double = (2*) |
|||
ethiopicmult a b = sum <| map snd <| filter (odd << fst) <| zip |
|||
(takeWhile (>=1) <| iterate halve a) |
|||
(iterate double b) |
|||
ethiopicmult 17 34</syntaxhighlight>{{out}} |
|||
578 |
|||
=={{header|Elixir}}== |
|||
{{trans|Erlang}} |
|||
<syntaxhighlight lang="elixir">defmodule Ethiopian do |
|||
def halve(n), do: div(n, 2) |
|||
def double(n), do: n * 2 |
|||
def even(n), do: rem(n, 2) == 0 |
|||
def multiply(lhs, rhs) when is_integer(lhs) and lhs > 0 and is_integer(rhs) and rhs > 0 do |
|||
multiply(lhs, rhs, 0) |
|||
end |
|||
def multiply(1, rhs, acc), do: rhs + acc |
|||
def multiply(lhs, rhs, acc) do |
|||
if even(lhs), do: multiply(halve(lhs), double(rhs), acc), |
|||
else: multiply(halve(lhs), double(rhs), acc+rhs) |
|||
end |
|||
end |
|||
IO.inspect Ethiopian.multiply(17, 34)</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
578 |
|||
</pre> |
|||
=={{header|Emacs Lisp}}== |
|||
Emacs Lisp has <code>cl-evenp</code> in cl-lib.el (its Common Lisp library), but for the sake of completeness the desired effect is achieved here via <code>mod</code>. |
|||
<syntaxhighlight lang="lisp">(defun even-p (n) |
|||
(= (mod n 2) 0)) |
|||
(defun halve (n) |
|||
(floor n 2)) |
|||
(defun double (n) |
|||
(* n 2)) |
|||
(defun ethiopian-multiplication (l r) |
|||
(let ((sum 0)) |
|||
(while (>= l 1) |
|||
(unless (even-p l) |
|||
(setq sum (+ r sum))) |
|||
(setq l (halve l)) |
|||
(setq r (double r))) |
|||
sum))</syntaxhighlight> |
|||
=={{header|EMal}}== |
|||
<syntaxhighlight lang="emal"> |
|||
fun halve = int by int value do return value / 2 end |
|||
fun double = int by int value do return value * 2 end |
|||
fun isEven = logic by int value do return value % 2 == 0 end |
|||
fun ethiopian = int by int multiplicand, int multiplier |
|||
int product |
|||
while multiplicand >= 1 |
|||
if not isEven(multiplicand) do product += multiplier end |
|||
multiplicand = halve(multiplicand) |
|||
multiplier = double(multiplier) |
|||
end |
|||
return product |
|||
end |
|||
writeLine(ethiopian(17, 34)) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
578 |
|||
</pre> |
|||
=={{header|Erlang}}== |
|||
<syntaxhighlight lang="erlang">-module(ethopian). |
|||
-export([multiply/2]). |
|||
halve(N) -> |
|||
N div 2. |
|||
double(N) -> |
|||
N * 2. |
|||
even(N) -> |
|||
(N rem 2) == 0. |
|||
multiply(LHS,RHS) when is_integer(Lhs) and Lhs > 0 and |
|||
is_integer(Rhs) and Rhs > 0 -> |
|||
multiply(LHS,RHS,0). |
|||
multiply(1,RHS,Acc) -> |
|||
RHS+Acc; |
|||
multiply(LHS,RHS,Acc) -> |
|||
case even(LHS) of |
|||
true -> |
|||
multiply(halve(LHS),double(RHS),Acc); |
|||
false -> |
|||
multiply(halve(LHS),double(RHS),Acc+RHS) |
|||
end.</syntaxhighlight> |
|||
=={{header|ERRE}}== |
|||
<syntaxhighlight lang="erre">PROGRAM ETHIOPIAN_MULT |
|||
FUNCTION EVEN(A) |
|||
EVEN=(A+1) MOD 2 |
|||
END FUNCTION |
|||
FUNCTION HALF(A) |
|||
HALF=INT(A/2) |
|||
END FUNCTION |
|||
FUNCTION DOUBLE(A) |
|||
DOUBLE=2*A |
|||
END FUNCTION |
|||
BEGIN |
|||
X=17 Y=34 TOT=0 |
|||
WHILE X>=1 DO |
|||
PRINT(X,) |
|||
IF EVEN(X)=0 THEN TOT=TOT+Y PRINT(Y) ELSE PRINT END IF |
|||
X=HALF(X) Y=DOUBLE(Y) |
|||
END WHILE |
|||
PRINT("=",TOT) |
|||
END PROGRAM |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
17 34 |
|||
8 |
|||
4 |
|||
2 |
|||
1 544 |
|||
= 578 |
|||
=={{header|Euphoria}}== |
|||
<syntaxhighlight lang="euphoria">function emHalf(integer n) |
|||
return floor(n/2) |
|||
end function |
|||
function emDouble(integer n) |
|||
return n*2 |
|||
end function |
|||
function emIsEven(integer n) |
|||
return (remainder(n,2) = 0) |
|||
end function |
|||
function emMultiply(integer a, integer b) |
|||
integer sum |
|||
sum = 0 |
|||
while (a) do |
|||
if (not emIsEven(a)) then sum += b end if |
|||
a = emHalf(a) |
|||
b = emDouble(b) |
|||
end while |
|||
return sum |
|||
end function |
|||
---------------------------------------------------------------- |
|||
-- runtime |
|||
printf(1,"emMultiply(%d,%d) = %d\n",{17,34,emMultiply(17,34)}) |
|||
printf(1,"\nPress Any Key\n",{}) |
|||
while (get_key() = -1) do end while</syntaxhighlight> |
|||
=={{header|F Sharp|F#}}== |
|||
<syntaxhighlight lang="fsharp">let ethopian n m = |
|||
let halve n = n / 2 |
|||
let double n = n * 2 |
|||
let even n = n % 2 = 0 |
|||
let rec loop n m result = |
|||
if n <= 1 then result + m |
|||
else if even n then loop (halve n) (double m) result |
|||
else loop (halve n) (double m) (result + m) |
|||
loop n m 0</syntaxhighlight> |
|||
=={{header|Factor}}== |
|||
<syntaxhighlight lang="factor">USING: arrays kernel math multiline sequences ; |
|||
IN: ethiopian-multiplication |
|||
/* |
|||
This function is built-in |
|||
: odd? ( n -- ? ) 1 bitand 1 number= ; |
|||
*/ |
|||
: double ( n -- 2*n ) 2 * ; |
|||
: halve ( n -- n/2 ) 2 /i ; |
|||
: ethiopian-mult ( a b -- a*b ) |
|||
[ 0 ] 2dip |
|||
[ dup 0 > ] [ |
|||
[ odd? [ + ] [ drop ] if ] 2keep |
|||
[ double ] [ halve ] bi* |
|||
] while 2drop ;</syntaxhighlight> |
|||
=={{header|FALSE}}== |
|||
<syntaxhighlight lang="false">[2/]h: |
|||
[2*]d: |
|||
[$2/2*-]o: |
|||
[0[@$][$o;![@@\$@+@]?h;!@d;!@]#%\%]m: |
|||
17 34m;!. {578}</syntaxhighlight> |
|||
=={{header|Forth}}== |
=={{header|Forth}}== |
||
Halve and double are standard words, spelled '''2/''' and '''2*''' respectively. |
|||
<lang forth>: e* ( x y -- x*y ) |
|||
<syntaxhighlight lang="forth">: even? ( n -- ? ) 1 and 0= ; |
|||
: e* ( x y -- x*y ) |
|||
dup 0= if nip exit then |
dup 0= if nip exit then |
||
over 2* over 2/ recurse |
over 2* over 2/ recurse |
||
swap even? if nip else + then ;</syntaxhighlight>The author of Forth, Chuck Moore, designed a similar primitive into his MISC Forth microprocessors. The '''+*''' instruction is a multiply step: it adds S to T if A is odd, then shifts both A and T right one. The idea is that you only need to perform as many of these multiply steps as you have significant bits in the operand.(See his [http://www.colorforth.com/inst.htm core instruction set] for details.) |
|||
swap 1 and if + else nip then ;</lang> |
|||
The author of Forth, Chuck Moore, designed a similar primitive into his MISC Forth microprocessors. The '''+*''' instruction is a multiply step: it adds S to T if A is odd, then shifts both A and T right one. The idea is that you only need to perform as many of these multiply steps as you have significant bits in the operand. (See his [http://www.colorforth.com/inst.htm core instruction set] for details.) |
|||
=={{header|Fortran}}== |
=={{header|Fortran}}== |
||
{{works with|Fortran|90 and later}} |
{{works with|Fortran|90 and later}}<syntaxhighlight lang="fortran">program EthiopicMult |
||
<lang fortran>program EthiopicMult |
|||
implicit none |
implicit none |
||
Line 543: | Line 3,000: | ||
end function ethiopic |
end function ethiopic |
||
end program EthiopicMult</ |
end program EthiopicMult</syntaxhighlight> |
||
=={{header|Fōrmulæ}}== |
|||
{{FormulaeEntry|page=https://formulae.org/?script=examples/Ancient_Egyptian_multiplication}} |
|||
'''Solution''' |
|||
[[File:Fōrmulæ - Ancient Egyptian multiplication 01.png]] |
|||
'''Test case''' |
|||
[[File:Fōrmulæ - Ancient Egyptian multiplication 02.png]] |
|||
[[File:Fōrmulæ - Ancient Egyptian multiplication 03.png]] |
|||
Because the required functions are either simple or intrinsic, the solution can be much simpler: |
|||
[[File:Fōrmulæ - Ancient Egyptian multiplication 04.png]] |
|||
=={{header|FutureBasic}}== |
|||
<syntaxhighlight lang="futurebasic"> |
|||
local fn Doubled( n as long ) : end fn = n * 2 |
|||
local fn Halved( n as long ) : end fn = int( n / 2 ) |
|||
local fn IsEven( n as long ) : end fn = ( n mod 2 ) - 1 |
|||
local fn EthiopianMultiply( x as long, y as long ) |
|||
long sum = 0, sign = x |
|||
printf @"Ethiopian multiplication of %3ld x %3ld = \b", x, y |
|||
do |
|||
if not ( fn IsEven( x ) ) then sum += y |
|||
x = fn Halved( x ) : y = fn Doubled( y ) |
|||
until ( x == 0 ) |
|||
if sign < 0 then sum *= - 1 |
|||
printf @"%4ld", sum |
|||
end fn |
|||
fn EthiopianMultiply( 17, 34 ) |
|||
fn EthiopianMultiply( -17, 34 ) |
|||
fn EthiopianMultiply( -17, -34 ) |
|||
HandleEvents |
|||
</syntaxhighlight> |
|||
{{output}} |
|||
<pre> |
|||
Ethiopian multiplication of 17 x 34 = 578 |
|||
Ethiopian multiplication of -17 x 34 = -578 |
|||
Ethiopian multiplication of -17 x -34 = 578 |
|||
</pre> |
|||
=={{header|Go}}== |
|||
<syntaxhighlight lang="go">package main |
|||
import "fmt" |
|||
func halve(i int) int { return i/2 } |
|||
func double(i int) int { return i*2 } |
|||
func isEven(i int) bool { return i%2 == 0 } |
|||
func ethMulti(i, j int) (r int) { |
|||
for ; i > 0; i, j = halve(i), double(j) { |
|||
if !isEven(i) { |
|||
r += j |
|||
} |
|||
} |
|||
return |
|||
} |
|||
func main() { |
|||
fmt.Printf("17 ethiopian 34 = %d\n", ethMulti(17, 34)) |
|||
}</syntaxhighlight> |
|||
=={{header|Haskell}}== |
=={{header|Haskell}}== |
||
===Using integer (+)=== |
|||
<lang haskell>halve x = x `div` 2 |
|||
<syntaxhighlight lang="haskell">import Prelude hiding (odd) |
|||
double x = x * 2 |
|||
import Control.Monad (join) |
|||
halve :: Int -> Int |
|||
ethiopicmult :: Integral a => a -> a -> a |
|||
halve = (`div` 2) |
|||
ethiopicmult x y = ethiopicmult' x y 0 where |
|||
ethiopicmult' 0 _ acc = acc |
|||
ethiopicmult' plier pliand acc |
|||
| even plier = ethiopicmult' (halve plier) (double pliand) acc |
|||
| otherwise = ethiopicmult' (halve plier) (double pliand) (acc + pliand)</lang> |
|||
double :: Int -> Int |
|||
Alternately: |
|||
double = join (+) |
|||
<lang haskell>ethiopicmult :: Integral a => a -> a -> a |
|||
ethiopicmult x y = sum [pliand | (plier, pliand) <- rowsNonZero, odd plier] |
|||
where rowsNonZero = takeWhile ((/= 0) . fst) rows |
|||
rows = zip (iterate (`div` 2) x) (iterate (* 2) y)</lang> |
|||
odd :: Int -> Bool |
|||
'''Usage example''' from the interpreter |
|||
odd = (== 1) . (`mod` 2) |
|||
ethiopicmult :: Int -> Int -> Int |
|||
ethiopicmult a b = |
|||
sum $ |
|||
map snd $ |
|||
filter (odd . fst) $ |
|||
zip (takeWhile (>= 1) $ iterate halve a) (iterate double b) |
|||
main :: IO () |
|||
main = print $ ethiopicmult 17 34 == 17 * 34</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>*Main> ethiopicmult 17 34 |
<pre>*Main> ethiopicmult 17 34 |
||
578</pre> |
|||
===Fold after unfold=== |
|||
Logging the stages of the '''unfoldr''' and '''foldr''' applications: |
|||
<syntaxhighlight lang="haskell">import Data.List (inits, intercalate, unfoldr) |
|||
import Data.Tuple (swap) |
|||
import Debug.Trace (trace) |
|||
----------------- ETHIOPIAN MULTIPLICATION --------------- |
|||
ethMult :: Int -> Int -> Int |
|||
ethMult n m = |
|||
( trace |
|||
=<< (<> "\n") |
|||
. ((showDoubles pairs <> " = ") <>) |
|||
. show |
|||
) |
|||
(foldr addedWhereOdd 0 pairs) |
|||
where |
|||
pairs = zip (unfoldr halved n) (iterate doubled m) |
|||
doubled x = x + x |
|||
halved h |
|||
| 0 < h = |
|||
Just $ |
|||
trace |
|||
(showHalf h) |
|||
(swap $ quotRem h 2) |
|||
| otherwise = Nothing |
|||
addedWhereOdd (d, x) a |
|||
| 0 < d = (+) a x |
|||
| otherwise = a |
|||
---------------------- TRACE DISPLAY --------------------- |
|||
showHalf :: Int -> String |
|||
showHalf x = "halve: " <> rjust 6 ' ' (show (quotRem x 2)) |
|||
showDoubles :: [(Int, Int)] -> String |
|||
showDoubles xs = |
|||
"double:\n" |
|||
<> unlines (go <$> xs) |
|||
<> intercalate " + " (xs >>= f) |
|||
where |
|||
go x |
|||
| 0 < fst x = "-> " <> rjust 3 ' ' (show $ snd x) |
|||
| otherwise = rjust 6 ' ' $ show $ snd x |
|||
f (r, q) |
|||
| 0 < r = [show q] |
|||
| otherwise = [] |
|||
rjust :: Int -> Char -> String -> String |
|||
rjust n c s = drop (length s) (replicate n c <> s) |
|||
--------------------------- TEST ------------------------- |
|||
main :: IO () |
|||
main = do |
|||
print $ ethMult 17 34 |
|||
print $ ethMult 34 17</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>halve: (8,1) |
|||
halve: (4,0) |
|||
halve: (2,0) |
|||
halve: (1,0) |
|||
halve: (0,1) |
|||
double: |
|||
-> 34 |
|||
68 |
|||
136 |
|||
272 |
|||
-> 544 |
|||
34 + 544 = 578 |
|||
halve: (17,0) |
|||
halve: (8,1) |
|||
halve: (4,0) |
|||
halve: (2,0) |
|||
halve: (1,0) |
|||
halve: (0,1) |
|||
double: |
|||
17 |
|||
-> 34 |
|||
68 |
|||
136 |
|||
272 |
|||
-> 544 |
|||
34 + 544 = 578 |
|||
578 |
|||
578</pre> |
578</pre> |
||
===Using monoid mappend=== |
|||
=={{header|J}}== |
|||
Alternatively, we can express Ethiopian multiplication in terms of mappend and mempty, in place of '''(+)''' and '''0'''. |
|||
This additional generality means that our '''ethMult''' function can now replicate a string n times as readily as it multiplies an integer n times, or raises an integer to the nth power. |
|||
'''Solution''': |
|||
double =: 2&* NB. or the primitive +: |
|||
halve =: %&2 NB. or the primitive -: |
|||
even =: 2&| |
|||
<syntaxhighlight lang="haskell">import Control.Monad (join) |
|||
ethiop =: +/@(even@] # (double~ <@#)) (1>.<.@halve)^:a: |
|||
import Data.List (unfoldr) |
|||
import Data.Monoid (getProduct, getSum) |
|||
import Data.Tuple (swap) |
|||
----------------- ETHIOPIAN MULTIPLICATION --------------- |
|||
ethMult :: (Monoid m) => Int -> m -> m |
|||
ethMult n m = |
|||
foldr addedWhereOdd mempty $ |
|||
zip (unfoldr half n) $ iterate (join (<>)) m |
|||
half :: Integral b => b -> Maybe (b, b) |
|||
half n |
|||
| 0 /= n = Just . swap $ quotRem n 2 |
|||
| otherwise = Nothing |
|||
addedWhereOdd :: (Eq a, Num a, Semigroup p) => (a, p) -> p -> p |
|||
addedWhereOdd (d, x) a |
|||
| 0 /= d = a <> x |
|||
| otherwise = a |
|||
--------------------------- TEST ------------------------- |
|||
main :: IO () |
|||
main = do |
|||
mapM_ print $ |
|||
[ getSum $ ethMult 17 34, -- 34 * 17 |
|||
getProduct $ ethMult 3 34 -- 34 ^ 3 |
|||
] |
|||
-- [3 ^ 17, 4 ^ 17] |
|||
<> (getProduct <$> ([ethMult 17] <*> [3, 4])) |
|||
print $ ethMult 17 "34" |
|||
print $ ethMult 17 [3, 4]</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>578 |
|||
39304 |
|||
129140163 |
|||
17179869184 |
|||
"3434343434343434343434343434343434" |
|||
[3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4]</pre> |
|||
=={{header|HicEst}}== |
|||
<syntaxhighlight lang="hicest"> WRITE(Messagebox) ethiopian( 17, 34 ) |
|||
END ! of "main" |
|||
FUNCTION ethiopian(x, y) |
|||
ethiopian = 0 |
|||
left = x |
|||
right = y |
|||
DO i = x, 1, -1 |
|||
IF( isEven(left) == 0 ) ethiopian = ethiopian + right |
|||
IF( left == 1 ) RETURN |
|||
left = halve(left) |
|||
right = double(right) |
|||
ENDDO |
|||
END |
|||
FUNCTION halve( x ) |
|||
halve = INT( x/2 ) |
|||
END |
|||
FUNCTION double( x ) |
|||
double = 2 * x |
|||
END |
|||
FUNCTION isEven( x ) |
|||
isEven = MOD(x, 2) == 0 |
|||
END </syntaxhighlight> |
|||
=={{header|Icon}} and {{header|Unicon}}== |
|||
<syntaxhighlight lang="icon">procedure main(arglist) |
|||
while ethiopian(integer(get(arglist)),integer(get(arglist))) # multiply successive pairs of command line arguments |
|||
end |
|||
procedure ethiopian(i,j) # recursive Ethiopian multiplication |
|||
return ( if not even(i) then j # this exploits that icon control expressions return values |
|||
else 0 ) + |
|||
( if i ~= 0 then ethiopian(halve(i),double(j)) |
|||
else 0 ) |
|||
end |
|||
procedure double(i) |
|||
return i * 2 |
|||
end |
|||
procedure halve(i) |
|||
return i / 2 |
|||
end |
|||
procedure even(i) |
|||
return ( i % 2 = 0, i ) |
|||
end</syntaxhighlight>While not it seems a task requirement, most implementations have a tutorial version. This seemed easiest in an iterative version.<syntaxhighlight lang="icon">procedure ethiopian(i,j) # iterative tutor |
|||
local p,w |
|||
w := *j+3 |
|||
write("Ethiopian Multiplication of ",i," * ",j) |
|||
p := 0 |
|||
until i = 0 do { |
|||
writes(right(i,w),right(j,w)) |
|||
if not even(i) then { |
|||
p +:= j |
|||
write(" add") |
|||
} |
|||
else write(" discard") |
|||
i := halve(i) |
|||
j := double(j) |
|||
} |
|||
write(right("=",w),right(p,w)) |
|||
return p |
|||
end</syntaxhighlight> |
|||
=={{header|J}}== |
|||
'''Solution''':<syntaxhighlight lang="j">double =: 2&* |
|||
halve =: %&2 NB. or the primitive -: |
|||
odd =: 2&| |
|||
ethiop =: +/@(odd@] # (double~ <@#)) (1>.<.@halve)^:a:</syntaxhighlight> |
|||
'''Example''': |
'''Example''': |
||
17 ethiop 34 |
|||
578 |
578 |
||
Note that <code>double</code> will repeatedly double its right argument if given a repetition count for its left argument: |
|||
Note: this could be implemented more concisely as <tt>#.@(*#:)</tt>, which abides by the letter of the task, but [http://www.jsoftware.com/pipermail/programming/2009-July/015507.html evades its spirit]. |
|||
(<5) double 17 |
|||
17 34 68 136 272 |
|||
Note: this implementation assumes that the number on the right is a positive integer. In contexts where it can be negative, its absolute value should be used and you should multiply the result of ethiop by its sign.<syntaxhighlight lang="j">ethio=: *@] * (ethiop |)</syntaxhighlight> |
|||
Alternatively, if multiplying by negative 1 is prohibited, you can use a conditional function which optionally negates its argument.<syntaxhighlight lang="j">ethio=: *@] -@]^:(0 > [) (ethiop |)</syntaxhighlight> |
|||
Examples:<syntaxhighlight lang="j"> 7 ethio 11 |
|||
77 |
|||
7 ethio _11 |
|||
_77 |
|||
_7 ethio 11 |
|||
_77 |
|||
_7 ethio _11 |
|||
77</syntaxhighlight> |
|||
=={{header|Java}}== |
=={{header|Java}}== |
||
{{works with|Java|1.5+}} |
{{works with|Java|1.5+}} |
||
< |
<syntaxhighlight lang="java5">import java.util.HashMap; |
||
import java.util.Map; |
|||
import java.util.Scanner; |
import java.util.Scanner; |
||
public class Mult |
public class Mult{ |
||
public static void main(String[] args){ |
public static void main(String[] args){ |
||
Scanner sc = new Scanner(System.in); |
Scanner sc = new Scanner(System.in); |
||
Line 591: | Line 3,347: | ||
int second = sc.nextInt(); |
int second = sc.nextInt(); |
||
if(first < 0){ |
|||
HashMap <Integer, Integer> columns = new HashMap <Integer, Integer>(); |
|||
first = -first; |
|||
second = -second; |
|||
} |
|||
Map<Integer, Integer> columns = new HashMap<Integer, Integer>(); |
|||
columns.put(first, second); |
|||
int sum = isEven(first)? 0 : second; |
|||
do{ |
do{ |
||
first = |
first = halveInt(first); |
||
second = |
second = doubleInt(second); |
||
columns.put(first, second); |
columns.put(first, second); |
||
if(!isEven(first)){ |
|||
}while(first != 1); |
|||
sum += second; |
|||
int sum = 0; |
|||
for(int firstNum:columns.keySet()){ |
|||
if(!isEven(firstNum)){ |
|||
sum += columns.get(firstNum); |
|||
} |
} |
||
} |
}while(first > 1); |
||
System.out.println(sum); |
System.out.println(sum); |
||
} |
} |
||
Line 617: | Line 3,376: | ||
public static boolean isEven(int num){ |
public static boolean isEven(int num){ |
||
return num & 1 == 0; |
return (num & 1) == 0; |
||
} |
} |
||
}</syntaxhighlight>An optimised variant using the three helper functions from the other example.<syntaxhighlight lang="java5">/** |
|||
}</lang> |
|||
* This method will use ethiopian styled multiplication. |
|||
An optimised variant using the three helper functions from the other example. |
|||
* @param a Any non-negative integer. |
|||
<lang java5> |
|||
* @param b Any integer. |
|||
/** |
|||
* @result a multiplied by b |
|||
* This method will use ethiopian styled multiplication. |
|||
*/ |
|||
* @param a Any non-negative integer. |
|||
public static int ethiopianMultiply(int a, int b) { |
|||
* @param b Any integer. |
|||
if(a==0 || b==0) { |
|||
* @result a multiplied by b |
|||
return 0; |
|||
} |
|||
public static int ethiopianMultiply(int a, int b) { |
|||
int result = 0; |
|||
while(a>=1) { |
|||
return 0; |
|||
if(!isEven(a)) { |
|||
result+=b; |
|||
} |
} |
||
b = doubleInt(b); |
|||
a = halveInt(a); |
|||
if(!isEven(a)) { |
|||
result+=b; |
|||
} |
|||
b = doubleInt(b); |
|||
a = halveInt(a); |
|||
} |
|||
return result; |
|||
} |
} |
||
return result; |
|||
} |
|||
/** |
|||
* This method is an improved version that will use |
|||
* ethiopian styled multiplication, and also |
|||
* supports negative parameters. |
|||
* @param a Any integer. |
|||
* @param b Any integer. |
|||
* @result a multiplied by b |
|||
*/ |
|||
public static int ethiopianMultiplyWithImprovement(int a, int b) { |
|||
if(a==0 || b==0) { |
|||
return 0; |
|||
} |
|||
if(a<0) { |
|||
a=-a; |
|||
b=-b; |
|||
} else if(b>0 && a>b) { |
|||
int tmp = a; |
|||
a = b; |
|||
b = tmp; |
|||
} |
|||
int result = 0; |
|||
while(a>=1) { |
|||
if(!isEven(a)) { |
|||
result+=b; |
|||
} |
} |
||
b = doubleInt(b); |
|||
a = halveInt(a); |
|||
if(!isEven(a)) { |
|||
result+=b; |
|||
} |
|||
b = doubleInt(b); |
|||
a = halveInt(a); |
|||
} |
|||
return result; |
|||
} |
} |
||
return result; |
|||
</lang> |
|||
}</syntaxhighlight> |
|||
== |
=={{header|JavaScript}}== |
||
<syntaxhighlight lang="javascript">var eth = { |
|||
<lang javascript> |
|||
var eth = { |
|||
halve : function ( n ){ return Math.floor(n/2); }, |
halve : function ( n ){ return Math.floor(n/2); }, |
||
Line 696: | Line 3,449: | ||
if( !eth.isEven( a[i] ) ){ |
if( !eth.isEven( a[i] ) ){ |
||
sum += b[i]; |
sum += b[i]; |
||
} else { |
|||
break; |
|||
} |
} |
||
} |
} |
||
return sum + b[0]; |
return sum + b[0]; |
||
} |
|||
} |
|||
// eth.mult(17,34) returns 578</syntaxhighlight> |
|||
Or, avoiding the use of a multiplication operator in the version above, we can alternatively: |
|||
# Halve an integer, in this sense, with a right-shift (n >>= 1) |
|||
# Double an integer by addition to self (m += m) |
|||
# Test if an integer is odd by bitwise '''and''' (n & 1) |
|||
<syntaxhighlight lang="javascript">function ethMult(m, n) { |
|||
var o = !isNaN(m) ? 0 : ''; // same technique works with strings |
|||
if (n < 1) return o; |
|||
while (n > 1) { |
|||
if (n & 1) o += m; // 3. integer odd/even? (bit-wise and 1) |
|||
n >>= 1; // 1. integer halved (by right-shift) |
|||
m += m; // 2. integer doubled (addition to self) |
|||
} |
|||
return o + m; |
|||
} |
|||
ethMult(17, 34)</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>578</pre> |
|||
Note that the same function will also multiply strings with some efficiency, particularly where n is larger. See [[Repeat_a_string]] |
|||
<syntaxhighlight lang="javascript">ethMult('Ethiopian', 34)</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>"EthiopianEthiopianEthiopianEthiopianEthiopianEthiopian |
|||
EthiopianEthiopianEthiopianEthiopianEthiopianEthiopianEthiopian |
|||
EthiopianEthiopianEthiopianEthiopianEthiopianEthiopianEthiopian |
|||
EthiopianEthiopianEthiopianEthiopianEthiopianEthiopianEthiopian |
|||
EthiopianEthiopianEthiopianEthiopianEthiopianEthiopianEthiopian"</pre> |
|||
=={{header|jq}}== |
|||
The following implementation is intended for jq 1.4 and later. |
|||
If your jq has <tt>while/2</tt>, then the implementation of the inner function, <tt>pairs</tt>, can be simplified to:<syntaxhighlight lang="jq">def pairs: while( .[0] > 0; [ (.[0] | halve), (.[1] | double) ]);</syntaxhighlight><syntaxhighlight lang="jq">def halve: (./2) | floor; |
|||
def double: 2 * .; |
|||
def isEven: . % 2 == 0; |
|||
def ethiopian_multiply(a;b): |
|||
def pairs: recurse( if .[0] > 0 |
|||
then [ (.[0] | halve), (.[1] | double) ] |
|||
else empty |
|||
end ); |
|||
reduce ([a,b] | pairs |
|||
| select( .[0] | isEven | not) |
|||
| .[1] ) as $i |
|||
(0; . + $i) ;</syntaxhighlight>Example:<syntaxhighlight lang="jq">ethiopian_multiply(17;34) # => 578</syntaxhighlight> |
|||
=={{header|Jsish}}== |
|||
From Javascript entry. |
|||
<syntaxhighlight lang="javascript">/* Ethiopian multiplication in Jsish */ |
|||
var eth = { |
|||
halve : function(n) { return Math.floor(n / 2); }, |
|||
double: function(n) { return n << 1; }, |
|||
isEven: function(n) { return n % 2 === 0; }, |
|||
mult: function(a, b){ |
|||
var sum = 0; |
|||
a = [a], b = [b]; |
|||
while (a[0] !== 1) { |
|||
a.unshift(eth.halve(a[0])); |
|||
b.unshift(eth.double(b[0])); |
|||
} |
|||
for (var i = a.length - 1; i > 0; i -= 1) { |
|||
if(!eth.isEven(a[i])) sum += b[i]; |
|||
} |
|||
return sum + b[0]; |
|||
} |
|||
}; |
|||
;eth.mult(17,34); |
|||
/* |
|||
=!EXPECTSTART!= |
|||
eth.mult(17,34) ==> 578 |
|||
=!EXPECTEND!= |
|||
*/</syntaxhighlight> |
|||
{{out}} |
|||
<pre>prompt$ jsish -u ethiopianMultiplication.jsi |
|||
[PASS] ethiopianMultiplication.jsi</pre> |
|||
=={{header|Julia}}== |
|||
{{works with|Julia|0.6}} |
|||
'''Helper functions''' (type stable): |
|||
<syntaxhighlight lang="julia">halve(x::Integer) = x >> one(x) |
|||
double(x::Integer) = Int8(2) * x |
|||
even(x::Integer) = x & 1 != 1</syntaxhighlight> |
|||
'''Main function''': |
|||
<syntaxhighlight lang="julia">function ethmult(a::Integer, b::Integer) |
|||
r = 0 |
|||
while a > 0 |
|||
r += b * !even(a) |
|||
a = halve(a) |
|||
b = double(b) |
|||
end |
|||
return r |
|||
end |
|||
@show ethmult(17, 34)</syntaxhighlight> |
|||
'''Array version''' (more similar algorithm to the one from the task description): |
|||
<syntaxhighlight lang="julia">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)]) |
|||
end |
|||
@show ethmult2(17, 34)</syntaxhighlight> |
|||
{{out}} |
|||
<pre>ethmult(17, 34) = 578 |
|||
ethmult2(17, 34) = 578</pre> |
|||
'''Benchmark test''': |
|||
<pre>julia> @time ethmult(17, 34) |
|||
0.000003 seconds (5 allocations: 176 bytes) |
|||
578 |
|||
julia> @time ethmult2(17, 34) |
|||
0.000007 seconds (18 allocations: 944 bytes) |
|||
578 |
|||
</pre> |
|||
=={{header|Kotlin}}== |
|||
<syntaxhighlight lang="scala">// version 1.1.2 |
|||
fun halve(n: Int) = n / 2 |
|||
fun double(n: Int) = n * 2 |
|||
fun isEven(n: Int) = n % 2 == 0 |
|||
fun ethiopianMultiply(x: Int, y: Int): Int { |
|||
var xx = x |
|||
var yy = y |
|||
var sum = 0 |
|||
while (xx >= 1) { |
|||
if (!isEven(xx)) sum += yy |
|||
xx = halve(xx) |
|||
yy = double(yy) |
|||
} |
|||
return sum |
|||
} |
|||
fun main(args: Array<String>) { |
|||
println("17 x 34 = ${ethiopianMultiply(17, 34)}") |
|||
println("99 x 99 = ${ethiopianMultiply(99, 99)}") |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
17 x 34 = 578 |
|||
99 x 99 = 9801 |
|||
</pre> |
|||
=== Literally follow the algorithm using generateSequence() === |
|||
<syntaxhighlight lang="kotlin"> |
|||
fun Int.halve() = this shr 1 |
|||
fun Int.double() = this shl 1 |
|||
fun Int.isOdd() = this and 1 == 1 |
|||
fun ethiopianMultiply(n: Int, m: Int): Int = |
|||
generateSequence(Pair(n, m)) { p -> Pair(p.first.halve(), p.second.double()) } |
|||
.takeWhile { it.first >= 1 }.filter { it.first.isOdd() }.sumOf { it.second } |
|||
fun main() { |
|||
ethiopianMultiply(17, 34).also { println(it) } // 578 |
|||
ethiopianMultiply(99, 99).also { println(it) } // 9801 |
|||
ethiopianMultiply(4, 8).also { println(it) } // 32 |
|||
} |
|||
</syntaxhighlight> |
|||
=={{header|Lambdatalk}}== |
|||
A translation from the javascript entry. |
|||
<syntaxhighlight lang="scheme"> |
|||
{def halve {lambda {:n} {floor {/ :n 2}}}} |
|||
-> halve |
|||
{def double {lambda {:n} {* 2 :n}}} |
|||
-> double |
|||
{def isEven {lambda {:n} {= {% :n 2} 0}}} |
|||
-> isEven |
|||
{def mult |
|||
{def mult.r |
|||
{lambda {:a :b} |
|||
{if {= {A.first :a} 1} |
|||
then {+ {S.map {{lambda {:a :b :i} |
|||
{if {isEven {A.get :i :a}} |
|||
then else {A.get :i :b}}} :a :b} |
|||
{S.serie {- {A.length :a} 1} 0 -1}}} |
|||
else {mult.r {A.addfirst! {halve {A.first :a}} :a} |
|||
{A.addfirst! {double {A.first :b}} :b}}}}} |
|||
{lambda {:a :b} |
|||
{mult.r {A.new :a} {A.new :b}}}} |
|||
-> mult |
|||
{mult 17 34} |
|||
-> 578 |
|||
</syntaxhighlight> |
|||
=={{header|Limbo}}== |
|||
<syntaxhighlight lang="limbo">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; |
|||
} |
} |
||
</syntaxhighlight> |
|||
=={{header|Locomotive Basic}}== |
|||
// eth.mult(17,34) returns 578 |
|||
</lang> |
|||
<syntaxhighlight lang="locobasic">10 DEF FNiseven(a)=(a+1) MOD 2 |
|||
20 DEF FNhalf(a)=INT(a/2) |
|||
30 DEF FNdouble(a)=2*a |
|||
40 x=17:y=34:tot=0 |
|||
50 WHILE x>=1 |
|||
60 PRINT x, |
|||
70 IF FNiseven(x)=0 THEN tot=tot+y:PRINT y ELSE PRINT |
|||
80 x=FNhalf(x):y=FNdouble(y) |
|||
90 WEND |
|||
100 PRINT "=", tot</syntaxhighlight> |
|||
Output: |
|||
<pre> |
|||
17 34 |
|||
8 |
|||
4 |
|||
2 |
|||
1 544 |
|||
= 578 |
|||
</pre> |
|||
=={{header|Logo}}== |
=={{header|Logo}}== |
||
<syntaxhighlight lang="logo">to double :x |
|||
<lang logo> |
|||
to double :x |
|||
output ashift :x 1 |
output ashift :x 1 |
||
end |
end |
||
Line 725: | Line 3,774: | ||
[output eproduct halve :x double :y] ~ |
[output eproduct halve :x double :y] ~ |
||
[output :y + eproduct halve :x double :y] |
[output :y + eproduct halve :x double :y] |
||
end</syntaxhighlight> |
|||
=={{header|LOLCODE}}== |
|||
<syntaxhighlight lang="lolcode">HAI 1.3 |
|||
HOW IZ I Halve YR Integer |
|||
FOUND YR QUOSHUNT OF Integer AN 2 |
|||
IF U SAY SO |
|||
HOW IZ I Dubble YR Integer |
|||
FOUND YR PRODUKT OF Integer AN 2 |
|||
IF U SAY SO |
|||
HOW IZ I IzEven YR Integer |
|||
FOUND YR BOTH SAEM 0 AN MOD OF Integer AN 2 |
|||
IF U SAY SO |
|||
HOW IZ I EthiopianProdukt YR a AN YR b |
|||
I HAS A Result ITZ 0 |
|||
IM IN YR Loop UPPIN YR x WILE DIFFRINT a AN 0 |
|||
NOT I IZ IzEven YR a MKAY |
|||
O RLY? |
|||
YA RLY |
|||
Result R SUM OF Result AN b |
|||
OIC |
|||
a R I IZ Halve YR a MKAY |
|||
b R I IZ Dubble YR b MKAY |
|||
IM OUTTA YR Loop |
|||
FOUND YR Result |
|||
IF U SAY SO |
|||
VISIBLE I IZ EthiopianProdukt YR 17 AN YR 34 MKAY |
|||
KTHXBYE</syntaxhighlight> |
|||
Output: <pre>578</pre> |
|||
=={{header|Lua}}== |
|||
<syntaxhighlight lang="lua">function halve(a) |
|||
return a/2 |
|||
end |
end |
||
</lang> |
|||
function double(a) |
|||
return a*2 |
|||
end |
|||
function isEven(a) |
|||
return a%2 == 0 |
|||
end |
|||
function ethiopian(x, y) |
|||
local result = 0 |
|||
while (x >= 1) do |
|||
if not isEven(x) then |
|||
result = result + y |
|||
end |
|||
x = math.floor(halve(x)) |
|||
y = double(y) |
|||
end |
|||
return result; |
|||
end |
|||
print(ethiopian(17, 34))</syntaxhighlight> |
|||
=={{header|M2000 Interpreter}}== |
|||
<syntaxhighlight lang="m2000 interpreter"> |
|||
Module EthiopianMultiplication{ |
|||
Form 60, 25 |
|||
Const Center=2, ColumnWith=12 |
|||
Report Center,"Ethiopian Method of Multiplication" |
|||
// using decimals as unsigned integers |
|||
Def Decimal leftval, rightval, sum |
|||
(leftval, rightval)=(random(1, 65535), random(1, 65536)) |
|||
Print $( , ColumnWith), "Target:", leftval*rightval, |
|||
Hex leftval*rightval |
|||
sum=0 |
|||
if @IsEven(leftval) Else sum+=rightval |
|||
Print leftval, rightval, |
|||
Hex leftval, rightval |
|||
while leftval>1 |
|||
leftval=@halveInt(leftval) |
|||
rightval=@DoubleInt(rightval) |
|||
Print leftval, rightval, |
|||
Hex leftval, rightval |
|||
if @IsEven(leftval) Else sum+=rightval |
|||
End while |
|||
Print "", sum |
|||
Hex "", sum |
|||
Function HalveInt(i) |
|||
=Binary.Shift(i,-1) |
|||
End Function |
|||
Function DoubleInt(i) |
|||
=Binary.Shift(i,1) |
|||
End Function |
|||
Function IsEven(i) |
|||
=Binary.And(i, 1)=0 |
|||
End Function |
|||
} |
|||
EthiopianMultiplication |
|||
</syntaxhighlight> |
|||
=={{header|Mathematica}} / {{header|Wolfram Language}}== |
|||
<syntaxhighlight lang="mathematica">IntegerHalving[x_]:=Floor[x/2] |
|||
IntegerDoubling[x_]:=x*2; |
|||
OddInteger OddQ |
|||
Ethiopian[x_, y_] := |
|||
Total[Select[NestWhileList[{IntegerHalving[#[[1]]],IntegerDoubling[#[[2]]]}&, {x,y}, (#[[1]]>1&)], OddQ[#[[1]]]&]][[2]] |
|||
Ethiopian[17, 34]</syntaxhighlight> |
|||
Output: |
|||
<pre>578</pre> |
|||
=={{header|MATLAB}}== |
|||
First we define the three subroutines needed for this task. These must be saved in their own individual ".m" files. The file names must be the same as the function name stored in that file. Also, they must be saved in the same directory as the script that performs the Ethiopian Multiplication. |
|||
In addition, with the exception of the "isEven" and "doubleInt" functions, the inputs of the functions have to be an integer data type. This means that the input to these functions must be coerced from the default IEEE754 double precision floating point data type that all numbers and variables are represented as, to integer data types. As of MATLAB 2007a, 64-bit integer arithmetic is not supported. So, at best, these will work for 32-bit integer data types. |
|||
halveInt.m: |
|||
<syntaxhighlight lang="matlab">function result = halveInt(number) |
|||
result = idivide(number,2,'floor'); |
|||
end</syntaxhighlight> |
|||
doubleInt.m: |
|||
<syntaxhighlight lang="matlab">function result = doubleInt(number) |
|||
result = times(2,number); |
|||
end</syntaxhighlight> |
|||
isEven.m: |
|||
<syntaxhighlight lang="matlab">%Returns a logical 1 if the number is even, 0 otherwise. |
|||
function trueFalse = isEven(number) |
|||
trueFalse = logical( mod(number,2)==0 ); |
|||
end</syntaxhighlight> |
|||
ethiopianMultiplication.m: |
|||
<syntaxhighlight lang="matlab">function answer = ethiopianMultiplication(multiplicand,multiplier) |
|||
%Generate columns |
|||
while multiplicand(end)>1 |
|||
multiplicand(end+1,1) = halveInt( multiplicand(end) ); |
|||
multiplier(end+1,1) = doubleInt( multiplier(end) ); |
|||
end |
|||
%Strike out appropriate rows |
|||
multiplier( isEven(multiplicand) ) = []; |
|||
%Generate answer |
|||
answer = sum(multiplier); |
|||
end</syntaxhighlight> |
|||
Sample input: (with data type coercion) |
|||
<syntaxhighlight lang="matlab">ethiopianMultiplication( int32(17),int32(34) ) |
|||
ans = |
|||
578 |
|||
</syntaxhighlight> |
|||
=={{header|Maxima}}== |
|||
<syntaxhighlight lang="maxima"> |
|||
/* Function to halve */ |
|||
halve(n):=floor(n/2)$ |
|||
/* Function to double */ |
|||
double(n):=2*n$ |
|||
/* Predicate function to check wether an integer is even */ |
|||
my_evenp(n):=if mod(n,2)=0 then true$ |
|||
/* Function that implements ethiopian function using the three previously defined functions */ |
|||
ethiopian(n1,n2):=block(cn1:n1,cn2:n2,list_w:[], |
|||
while cn1>0 do (list_w:endcons(cn1,list_w),cn1:halve(cn1)), |
|||
n2_list:append([cn2],makelist(cn2:double(cn2),length(list_w)-1)), |
|||
sublist_indices(list_w,lambda([x],not my_evenp(x))), |
|||
makelist(n2_list[i],i,%%), |
|||
apply("+",%%))$ |
|||
</syntaxhighlight> |
|||
=={{header|Metafont}}== |
=={{header|Metafont}}== |
||
Implemented without the ''tutor''. |
Implemented without the ''tutor''. |
||
< |
<syntaxhighlight lang="metafont">vardef halve(expr x) = floor(x/2) enddef; |
||
vardef double(expr x) = x*2 enddef; |
vardef double(expr x) = x*2 enddef; |
||
vardef iseven(expr x) = if (x mod 2) = 0: true else: false fi enddef; |
vardef iseven(expr x) = if (x mod 2) = 0: true else: false fi enddef; |
||
Line 749: | Line 3,982: | ||
show( (17 ethiopicmult 34) ); |
show( (17 ethiopicmult 34) ); |
||
end</ |
end</syntaxhighlight> |
||
=={{header|МК-61/52}}== |
|||
<syntaxhighlight lang="text">П1 П2 <-> П0 |
|||
ИП0 1 - x#0 29 |
|||
ИП1 2 * П1 |
|||
ИП0 2 / [x] П0 |
|||
2 / {x} x#0 04 ИП2 ИП1 + П2 |
|||
БП 04 |
|||
ИП2 С/П</syntaxhighlight> |
|||
=={{header|MMIX}}== |
|||
In order to assemble and run this program you'll have to install MMIXware from [http://www-cs-faculty.stanford.edu/~knuth/mmix-news.html]. This provides you with a simple assembler, a simulator, example programs and full documentation. |
|||
<syntaxhighlight lang="mmix">A IS 17 |
|||
B IS 34 |
|||
pliar IS $255 % designating main registers |
|||
pliand GREG |
|||
acc GREG |
|||
str IS pliar % reuse reg $255 for printing |
|||
LOC Data_Segment |
|||
GREG @ |
|||
BUF OCTA #3030303030303030 % reserve a buffer that is big enough to hold |
|||
OCTA #3030303030303030 % a max (signed) 64 bit integer: |
|||
OCTA #3030300a00000000 % 2^63 - 1 = 9223372036854775807 |
|||
% string is terminated with NL, 0 |
|||
LOC #1000 % locate program at address |
|||
GREG @ |
|||
halve SR pliar,pliar,1 |
|||
GO $127,$127,0 |
|||
double SL pliand,pliand,1 |
|||
GO $127,$127,0 |
|||
odd DIV $77,pliar,2 |
|||
GET $78,rR |
|||
GO $127,$127,0 |
|||
% Main is the entry point of the program |
|||
Main SET pliar,A % initialize registers for calculation |
|||
SET pliand,B |
|||
SET acc,0 |
|||
1H GO $127,odd |
|||
BZ $78,2F % if pliar is even skip incr. acc with pliand |
|||
ADD acc,acc,pliand % |
|||
2H GO $127,halve % halve pliar |
|||
GO $127,double % and double pliand |
|||
PBNZ pliar,1B % repeat from 1H while pliar > 0 |
|||
// result: acc = 17 x 34 |
|||
// next: print result --> stdout |
|||
// $0 is a temp register |
|||
LDA str,BUF+19 % points after the end of the string |
|||
2H SUB str,str,1 % update buffer pointer |
|||
DIV acc,acc,10 % do a divide and mod |
|||
GET $0,rR % get digit from special purpose reg. rR |
|||
% containing the remainder of the division |
|||
INCL $0,'0' % convert to ascii |
|||
STBU $0,str % place digit in buffer |
|||
PBNZ acc,2B % next |
|||
% 'str' points to the start of the result |
|||
TRAP 0,Fputs,StdOut % output answer to stdout |
|||
TRAP 0,Halt,0 % exit</syntaxhighlight> |
|||
Assembling: |
|||
<pre>~/MIX/MMIX/Progs> mmixal ethiopianmult.mms</pre> |
|||
Running: |
|||
<pre>~/MIX/MMIX/Progs> mmix ethiopianmult |
|||
578</pre> |
|||
=={{header|Modula-2}}== |
|||
{{works with|ADW Modula-2|any (Compile with the linker option ''Console Application'').}} |
|||
<syntaxhighlight lang="modula2"> |
|||
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 A 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 NOT(IsEven(X)) THEN |
|||
INC(Tot, Y); |
|||
WriteCard(Y, 9) |
|||
END; |
|||
WriteLn; |
|||
Halve(X); |
|||
Double(Y); |
|||
END; |
|||
WriteString("= "); |
|||
WriteCard(Tot, 9); |
|||
WriteLn; |
|||
END EthiopianMultiplication. |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
17 34 |
|||
8 |
|||
4 |
|||
2 |
|||
1 544 |
|||
= 578 |
|||
</pre> |
|||
=={{header|Modula-3}}== |
=={{header|Modula-3}}== |
||
{{trans|Ada}} |
{{trans|Ada}} |
||
< |
<syntaxhighlight lang="modula3">MODULE Ethiopian EXPORTS Main; |
||
IMPORT IO, Fmt; |
IMPORT IO, Fmt; |
||
Line 789: | Line 4,150: | ||
BEGIN |
BEGIN |
||
IO.Put(" |
IO.Put("17 times 34 = " & Fmt.Int(Multiply(17, 34)) & "\n"); |
||
END Ethiopian.</ |
END Ethiopian.</syntaxhighlight> |
||
=={{header|MUMPS}}== |
|||
<syntaxhighlight lang="mumps"> |
|||
HALVE(I) |
|||
;I should be an integer |
|||
QUIT I\2 |
|||
DOUBLE(I) |
|||
;I should be an integer |
|||
QUIT I*2 |
|||
ISEVEN(I) |
|||
;I should be an integer |
|||
QUIT '(I#2) |
|||
E2(M,N) |
|||
New W,A,E,L Set W=$Select($Length(M)>=$Length(N):$Length(M)+2,1:$L(N)+2),A=0,L=0,A(L,1)=M,A(L,2)=N |
|||
Write "Multiplying two numbers:" |
|||
For Write !,$Justify(A(L,1),W),?W,$Justify(A(L,2),W) Write:$$ISEVEN(A(L,1)) ?(2*W)," Struck" Set:'$$ISEVEN(A(L,1)) A=A+A(L,2) Set L=L+1,A(L,1)=$$HALVE(A(L-1,1)),A(L,2)=$$DOUBLE(A(L-1,2)) Quit:A(L,1)<1 |
|||
Write ! For E=W:1:(2*W) Write ?E,"=" |
|||
Write !,?W,$Justify(A,W),! |
|||
Kill W,A,E,L |
|||
Q</syntaxhighlight>{{out}} |
|||
USER>D E2^ROSETTA(1439,7) |
|||
Multiplying two numbers: |
|||
1439 7 |
|||
719 14 |
|||
359 28 |
|||
179 56 |
|||
89 112 |
|||
44 224 Struck |
|||
22 448 Struck |
|||
11 896 |
|||
5 1792 |
|||
2 3584 Struck |
|||
1 7168 |
|||
======= |
|||
10073 |
|||
=={{header|Nemerle}}== |
|||
<syntaxhighlight lang="nemerle">using System; |
|||
using System.Console; |
|||
module Ethiopian |
|||
{ |
|||
Multiply(x : int, y : int) : int |
|||
{ |
|||
def halve(a) {a / 2} |
|||
def doble(a) {a * 2} |
|||
def isEven(a) {a % 2 == 0} |
|||
def multiply(p, q) |
|||
{ |
|||
match(p) |
|||
{ |
|||
|p when (p < 1) => 0 |
|||
|p when (isEven(p)) => 0 + multiply(halve(p), doble(q)) |
|||
|_ => q + multiply(halve(p), doble(q)) |
|||
} |
|||
} |
|||
multiply(x, y) |
|||
} |
|||
Main() : void |
|||
{ |
|||
WriteLine("By Ethiopian multiplication, 17 * 34 = {0}", Multiply(17, 34)); |
|||
} |
|||
}</syntaxhighlight> |
|||
=={{header|NetRexx}}== |
|||
{{trans|REXX}} |
|||
<syntaxhighlight lang="netrexx">/* NetRexx */ |
|||
options replace format comments java crossref savelog symbols nobinary |
|||
/*REXX program multiplies 2 integers by Ethiopian/Russian peasant method*/ |
|||
numeric digits 1000 /*handle extremely large integers. */ |
|||
/*handles zeroes and negative integers.*/ |
|||
/*A & B should be checked if integers.*/ |
|||
parse arg a b . |
|||
say 'a=' a |
|||
say 'b=' b |
|||
say 'product=' emult(a,b) |
|||
return |
|||
method emult(x,y) private static |
|||
parse x x 1 ox |
|||
prod=0 |
|||
loop while x\==0 |
|||
if \iseven(x) then prod=prod+y |
|||
x=halve(x) |
|||
y=dubble(y) |
|||
end |
|||
return prod*ox.sign |
|||
method halve(x) private static |
|||
return x % 2 |
|||
method dubble(x) private static |
|||
return x + x |
|||
method iseven(x) private static |
|||
return x//2 == 0</syntaxhighlight> |
|||
=={{header|Nim}}== |
|||
<syntaxhighlight lang="nim">proc halve(x: int): int = x div 2 |
|||
proc double(x: int): int = x * 2 |
|||
proc odd(x: int): bool = x mod 2 != 0 |
|||
proc ethiopian(x, y: int): int = |
|||
var x = x |
|||
var y = y |
|||
while x >= 1: |
|||
if odd(x): |
|||
result += y |
|||
x = halve x |
|||
y = double y |
|||
echo ethiopian(17, 34)</syntaxhighlight> |
|||
{{out}} |
|||
<pre>578</pre> |
|||
=={{header|Objeck}}== |
|||
{{trans|Java}}<syntaxhighlight lang="objeck"> |
|||
use Collection; |
|||
class EthiopianMultiplication { |
|||
function : Main(args : String[]) ~ Nil { |
|||
first := IO.Console->ReadString()->ToInt(); |
|||
second := IO.Console->ReadString()->ToInt(); |
|||
"----"->PrintLine(); |
|||
Mul(first, second)->PrintLine(); |
|||
} |
|||
function : native : Mul(first : Int, second : Int) ~ Int { |
|||
if(first < 0){ |
|||
first := -1 * first; |
|||
second := -1 * second; |
|||
}; |
|||
sum := isEven(first)? 0 : second; |
|||
do { |
|||
first := halveInt(first); |
|||
second := doubleInt(second); |
|||
if(isEven(first) = false){ |
|||
sum += second; |
|||
}; |
|||
} |
|||
while(first > 1); |
|||
return sum; |
|||
} |
|||
function : halveInt(num : Int) ~ Bool { |
|||
return num >> 1; |
|||
} |
|||
function : doubleInt(num : Int) ~ Bool { |
|||
return num << 1; |
|||
} |
|||
function : isEven(num : Int) ~ Bool { |
|||
return (num and 1) = 0; |
|||
} |
|||
}</syntaxhighlight> |
|||
=={{header|Object Pascal}}== |
|||
multiplication.pas:<syntaxhighlight lang="pascal">unit Multiplication; |
|||
interface |
|||
function Double(Number: Integer): Integer; |
|||
function Halve(Number: Integer): Integer; |
|||
function Even(Number: Integer): Boolean; |
|||
function Ethiopian(NumberA, NumberB: Integer): Integer; |
|||
implementation |
|||
function Double(Number: Integer): Integer; |
|||
begin |
|||
result := Number * 2 |
|||
end; |
|||
function Halve(Number: Integer): Integer; |
|||
begin |
|||
result := Number div 2 |
|||
end; |
|||
function Even(Number: Integer): Boolean; |
|||
begin |
|||
result := Number mod 2 = 0 |
|||
end; |
|||
function Ethiopian(NumberA, NumberB: Integer): Integer; |
|||
begin |
|||
result := 0; |
|||
while NumberA >= 1 do |
|||
begin |
|||
if not Even(NumberA) then |
|||
result := result + NumberB; |
|||
NumberA := Halve(NumberA); |
|||
NumberB := Double(NumberB) |
|||
end |
|||
end; |
|||
begin |
|||
end.</syntaxhighlight>ethiopianmultiplication.pas:<syntaxhighlight lang="pascal">program EthiopianMultiplication; |
|||
uses |
|||
Multiplication; |
|||
begin |
|||
WriteLn('17 * 34 = ', Ethiopian(17, 34)) |
|||
end.</syntaxhighlight>{{out}} |
|||
17 * 34 = 578 |
|||
=={{header|Objective-C}}== |
=={{header|Objective-C}}== |
||
Using class methods except for the generic useful function <tt>iseven</tt>. |
Using class methods except for the generic useful function <tt>iseven</tt>. |
||
< |
<syntaxhighlight lang="objc">#import <stdio.h> |
||
#import <objc/Object.h> |
|||
BOOL iseven(int x) |
BOOL iseven(int x) |
||
Line 802: | Line 4,371: | ||
} |
} |
||
@interface EthiopicMult : |
@interface EthiopicMult : NSObject |
||
+ (int)mult: (int)plier by: (int)plicand; |
+ (int)mult: (int)plier by: (int)plicand; |
||
+ (int)halve: (int)a; |
+ (int)halve: (int)a; |
||
Line 833: | Line 4,402: | ||
int main() |
int main() |
||
{ |
{ |
||
@autoreleasepool { |
|||
printf("%d\n", [EthiopicMult mult: 17 by: 34]); |
|||
printf("%d\n", [EthiopicMult mult: 17 by: 34]); |
|||
} |
|||
return 0; |
return 0; |
||
}</ |
}</syntaxhighlight> |
||
=={{header|OCaml}}== |
=={{header|OCaml}}== |
||
<syntaxhighlight lang="ocaml">(* We optimize a bit by not keeping the intermediate lists, and summing |
|||
<lang ocaml>let ethiopicmult x y = |
|||
the right column on-the-fly, like in the C version. |
|||
let rec aux plier pliand acc = |
|||
The function takes "halve" and "double" operators and "is_even" predicate as arguments, |
|||
if plier = 0 then |
|||
but also "is_zero", "zero" and "add". This allows for more general uses of the |
|||
acc |
|||
ethiopian multiplication. *) |
|||
else if plier mod 2 = 0 then |
|||
let ethiopian is_zero is_even halve zero double add b a = |
|||
aux (plier / 2) (pliand * 2) acc |
|||
let rec g a b r = |
|||
if is_zero a |
|||
aux (plier / 2) (pliand * 2) (acc + pliand) |
|||
then (r) |
|||
else g (halve a) (double b) (if not (is_even a) then (add b r) else (r)) |
|||
in |
in |
||
g a b zero |
|||
;; |
|||
let imul = |
|||
ethiopian (( = ) 0) (fun x -> x mod 2 = 0) (fun x -> x / 2) 0 (( * ) 2) ( + );; |
|||
imul 17 34;; |
|||
(* - : int = 578 *) |
|||
(* Now, we have implemented the same algorithm as "rapid exponentiation", |
|||
merely changing operator names *) |
|||
let ipow = |
|||
ethiopian (( = ) 0) (fun x -> x mod 2 = 0) (fun x -> x / 2) 1 (fun x -> x*x) ( * ) |
|||
;; |
|||
ipow 2 16;; |
|||
(* - : int = 65536 *) |
|||
(* still renaming operators, if "halving" is just subtracting one, |
|||
and "doubling", adding one, then we get an addition *) |
|||
let iadd a b = |
|||
ethiopian (( = ) 0) (fun x -> false) (pred) b (function x -> x) (fun x y -> succ y) 0 a |
|||
;; |
|||
iadd 421 1000;; |
|||
(* - : int = 1421 *) |
|||
(* One can do much more with "ethiopian multiplication", |
|||
since the two "multiplicands" and the result may be of three different types, |
|||
as shown by the typing system of ocaml *) |
|||
ethiopian;; |
|||
- : ('a -> bool) -> (* is_zero *) |
|||
('a -> bool) -> (* is_even *) |
|||
('a -> 'a) -> (* halve *) |
|||
'b -> (* zero *) |
|||
('c -> 'c) -> (* double *) |
|||
('c -> 'b -> 'b) -> (* add *) |
|||
'c -> (* b *) |
|||
'a -> (* a *) |
|||
'b (* result *) |
|||
= <fun> |
|||
(* Here zero is the starting value for the accumulator of the sums |
|||
'''Usage example''' from the interpreter |
|||
of values in the right column in the original algorithm. But the "add" |
|||
<pre># ethiopicmult 17 34;; |
|||
me do something else, see for example the RosettaCode page on |
|||
- : int = 578</pre> |
|||
"Exponentiation operator". *)</syntaxhighlight> |
|||
=={{header|Octave}}== |
=={{header|Octave}}== |
||
< |
<syntaxhighlight lang="octave">function r = halve(a) |
||
r = floor(a/2); |
r = floor(a/2); |
||
endfunction |
endfunction |
||
Line 887: | Line 4,502: | ||
endfunction |
endfunction |
||
disp(ethiopicmult(17, 34, true))</ |
disp(ethiopicmult(17, 34, true))</syntaxhighlight> |
||
=={{header|Oforth}}== |
|||
Based on Forth version. |
|||
isEven is already defined for Integers. |
|||
<syntaxhighlight lang="oforth">: halve 2 / ; |
|||
: double 2 * ; |
|||
: ethiopian |
|||
dup ifZero: [ nip return ] |
|||
over double over halve ethiopian |
|||
swap isEven ifTrue: [ nip ] else: [ + ] ;</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
17 34 ethiopian . |
|||
578 |
|||
</pre> |
|||
=={{header|Ol}}== |
|||
<syntaxhighlight lang="ol"> |
|||
(define (ethiopian-multiplication l r) |
|||
(let ((even? (lambda (n) |
|||
(eq? (mod n 2) 0)))) |
|||
(let loop ((sum 0) (l l) (r r)) |
|||
(print "sum: " sum ", l: " l ", r: " r) |
|||
(if (eq? l 0) |
|||
sum |
|||
(loop |
|||
(if (even? l) (+ sum r) sum) |
|||
(floor (/ l 2)) (* r 2)))))) |
|||
(print (ethiopian-multiplication 17 34)) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
sum: 0, l: 17, r: 34 |
|||
sum: 0, l: 8, r: 68 |
|||
sum: 68, l: 4, r: 136 |
|||
sum: 204, l: 2, r: 272 |
|||
sum: 476, l: 1, r: 544 |
|||
sum: 476, l: 0, r: 1088 |
|||
476 |
|||
</pre> |
|||
=={{header|ooRexx}}== |
|||
The [[#REXX|Rexx]] solution shown herein applies equally to [[ooRexx]]. |
|||
=={{header|Oz}}== |
|||
<syntaxhighlight lang="oz">declare |
|||
fun {Halve X} X div 2 end |
|||
fun {Double X} X * 2 end |
|||
fun {Even X} {Abs X mod 2} == 0 end %% standard function: Int.isEven |
|||
fun {EthiopicMult X Y} |
|||
X >= 0 = true %% assert: X must not be negative |
|||
Rows = for |
|||
L in X; L>0; {Halve L} %% C-like iterator: "Init; While; Next" |
|||
R in Y; true; {Double R} |
|||
collect:Collect |
|||
do |
|||
{Collect L#R} |
|||
end |
|||
OddRows = {Filter Rows LeftIsOdd} |
|||
RightColumn = {Map OddRows SelectRight} |
|||
in |
|||
{Sum RightColumn} |
|||
end |
|||
%% Helpers |
|||
fun {LeftIsOdd L#_} {Not {Even L}} end |
|||
fun {SelectRight _#R} R end |
|||
fun {Sum Xs} {FoldL Xs Number.'+' 0} end |
|||
in |
|||
{Show {EthiopicMult 17 34}}</syntaxhighlight> |
|||
=={{header|PARI/GP}}== |
|||
<syntaxhighlight lang="parigp">halve(n)=n\2; |
|||
double(n)=2*n; |
|||
even(n)=!(n%2); |
|||
multE(a,b)={ my(d=0); |
|||
while(a, |
|||
if(!even(a), |
|||
d+=b); |
|||
a=halve(a); |
|||
b=double(b)); |
|||
d |
|||
};</syntaxhighlight> |
|||
=={{header|Pascal}}== |
|||
<syntaxhighlight lang="pascal">program EthiopianMultiplication; |
|||
{$IFDEF FPC} |
|||
{$MODE DELPHI} |
|||
{$ENDIF} |
|||
function Double(Number: Integer): Integer; |
|||
begin |
|||
Result := Number * 2 |
|||
end; |
|||
function Halve(Number: Integer): Integer; |
|||
begin |
|||
Result := Number div 2 |
|||
end; |
|||
function Even(Number: Integer): Boolean; |
|||
begin |
|||
Result := Number mod 2 = 0 |
|||
end; |
|||
function Ethiopian(NumberA, NumberB: Integer): Integer; |
|||
begin |
|||
Result := 0; |
|||
while NumberA >= 1 do |
|||
begin |
|||
if not Even(NumberA) then |
|||
Result := Result + NumberB; |
|||
NumberA := Halve(NumberA); |
|||
NumberB := Double(NumberB) |
|||
end |
|||
end; |
|||
begin |
|||
Write(Ethiopian(17, 34)) |
|||
end.</syntaxhighlight> |
|||
=={{header|PascalABC.NET}}== |
|||
<syntaxhighlight lang="delphi"> |
|||
function halve(x: integer): integer := x div 2; |
|||
function double(x: integer): integer := x * 2; |
|||
function odd(x: integer): boolean := x mod 2 <> 0; |
|||
function ethiopian(x, y: integer): integer; |
|||
begin |
|||
while x >= 1 do |
|||
begin |
|||
if odd(x) then result += y; |
|||
x := halve(x); |
|||
y := double(y); |
|||
end; |
|||
end; |
|||
begin |
|||
ethiopian(17, 34).println; |
|||
end. |
|||
</syntaxhighlight> |
|||
=={{header|Perl}}== |
=={{header|Perl}}== |
||
< |
<syntaxhighlight lang="perl">use strict; |
||
sub halve { |
sub halve { int((shift) / 2); } |
||
sub double { |
sub double { (shift) * 2; } |
||
sub iseven { |
sub iseven { ((shift) & 1) == 0; } |
||
sub ethiopicmult |
sub ethiopicmult |
||
Line 913: | Line 4,680: | ||
} |
} |
||
print ethiopicmult(17,34, 1), "\n";</ |
print ethiopicmult(17,34, 1), "\n";</syntaxhighlight> |
||
=={{header| |
=={{header|Phix}}== |
||
{{Trans|Euphoria}} |
|||
{{works with|Rakudo|#21 "Seattle"}} |
|||
<!--<syntaxhighlight lang="phix">(phixonline)--> |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">emHalf</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">)</span> |
|||
<lang perl6>sub halve (Int $n is rw) { $n div= 2 } |
|||
<span style="color: #008080;">return</span> <span style="color: #7060A8;">floor</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">/</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span> |
|||
sub double (Int $n is rw) { $n *= 2 } |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
sub even (Int $n --> Bool) { $n % 2 == 0 } |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">emDouble</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">)</span> |
|||
sub ethiopicmult (Int $a is copy, Int $b is copy --> Int) { |
|||
<span style="color: #008080;">return</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">*</span><span style="color: #000000;">2</span> |
|||
my Int $r = 0; |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
while $a { |
|||
even $a or $r += $b; |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">emIsEven</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">)</span> |
|||
halve $a; |
|||
<span style="color: #008080;">return</span> <span style="color: #0000FF;">(</span><span style="color: #7060A8;">remainder</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)=</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span> |
|||
double $b; |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
} |
|||
return $r; |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">emMultiply</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">)</span> |
|||
}</lang> |
|||
<span style="color: #004080;">integer</span> <span style="color: #7060A8;">sum</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span> |
|||
<span style="color: #008080;">while</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">do</span> |
|||
<span style="color: #008080;">if</span> <span style="color: #008080;">not</span> <span style="color: #000000;">emIsEven</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> <span style="color: #7060A8;">sum</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">b</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span> |
|||
<span style="color: #000000;">a</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">emHalf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #000000;">b</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">emDouble</span><span style="color: #0000FF;">(</span><span style="color: #000000;">b</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span> |
|||
<span style="color: #008080;">return</span> <span style="color: #7060A8;">sum</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"emMultiply(%d,%d) = %d\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">17</span><span style="color: #0000FF;">,</span><span style="color: #000000;">34</span><span style="color: #0000FF;">,</span><span style="color: #000000;">emMultiply</span><span style="color: #0000FF;">(</span><span style="color: #000000;">17</span><span style="color: #0000FF;">,</span><span style="color: #000000;">34</span><span style="color: #0000FF;">)})</span> |
|||
<!--</syntaxhighlight>--> |
|||
=={{header|PHP}}== |
=={{header|PHP}}== |
||
Not object oriented version:<syntaxhighlight lang="php"><?php |
|||
<lang php><?php |
|||
function halve($x) |
function halve($x) |
||
{ |
{ |
||
Line 946: | Line 4,724: | ||
function iseven($x) |
function iseven($x) |
||
{ |
{ |
||
return ($x |
return !($x & 0x1); |
||
} |
} |
||
Line 965: | Line 4,743: | ||
echo ethiopicmult(17, 34, true), "\n"; |
echo ethiopicmult(17, 34, true), "\n"; |
||
?></syntaxhighlight>{{out}} |
|||
?></lang> |
|||
ethiopic multiplication of 17 and 34 |
|||
17, 34 kept |
|||
8, 68 struck |
|||
4, 136 struck |
|||
2, 272 struck |
|||
1, 544 kept |
|||
578 |
|||
Object Oriented version: |
|||
{{works with|PHP5}}<syntaxhighlight lang="php"><?php |
|||
class ethiopian_multiply { |
|||
protected $result = 0; |
|||
protected function __construct($x, $y){ |
|||
while($x >= 1){ |
|||
$this->sum_result($x, $y); |
|||
$x = $this->half_num($x); |
|||
$y = $this->double_num($y); |
|||
} |
|||
} |
|||
protected function half_num($x){ |
|||
return floor($x/2); |
|||
} |
|||
protected function double_num($y){ |
|||
return $y*2; |
|||
} |
|||
protected function not_even($n){ |
|||
return $n%2 != 0 ? true : false; |
|||
} |
|||
protected function sum_result($x, $y){ |
|||
if($this->not_even($x)){ |
|||
$this->result += $y; |
|||
} |
|||
} |
|||
protected function get_result(){ |
|||
return $this->result; |
|||
} |
|||
static public function init($x, $y){ |
|||
$init = new ethiopian_multiply($x, $y); |
|||
return $init->get_result(); |
|||
} |
|||
} |
|||
echo ethiopian_multiply::init(17, 34); |
|||
?></syntaxhighlight> |
|||
=={{header|Picat}}== |
|||
===Iterative=== |
|||
<syntaxhighlight lang="picat">ethiopian(Multiplier, Multiplicand) = ethiopian(Multiplier, Multiplicand,false). |
|||
ethiopian(Multiplier, Multiplicand,Tutor) = Result => |
|||
if Tutor then |
|||
printf("\n%d * %d:\n",Multiplier, Multiplicand) |
|||
end, |
|||
Result1 = 0, |
|||
while (Multiplier >= 1) |
|||
OldResult = Result1, |
|||
if not even(Multiplier) then |
|||
Result1 := Result1 + Multiplicand |
|||
end, |
|||
if Tutor then |
|||
printf("%6d % 8s\n",Multiplier,cond(OldResult=Result1,"--",Multiplicand.to_string())) |
|||
end, |
|||
Multiplier := halve(Multiplier), |
|||
Multiplicand := double(Multiplicand) |
|||
end, |
|||
if Tutor then |
|||
println(" ======="), |
|||
printf(" %8s\n",Result1.to_string()), |
|||
nl |
|||
end, |
|||
Result = Result1.</syntaxhighlight> |
|||
===Recursion=== |
|||
{{trans|Prolog}} |
|||
<syntaxhighlight lang="picat">ethiopian2(First,Second,Product) => |
|||
ethiopian2(First,Second,0,Product). |
|||
ethiopian2(1,Second,Sum0,Sum) => |
|||
Sum = Sum0 + Second. |
|||
ethiopian2(First,Second,Sum0,Sum) => |
|||
Sum1 = Sum0 + Second*(First mod 2), |
|||
ethiopian2(halve(First), double(Second), Sum1, Sum). |
|||
halve(X) = X div 2. |
|||
double(X) = 2*X. |
|||
is_even(X) => X mod 2 = 0.</syntaxhighlight> |
|||
===Test=== |
|||
<syntaxhighlight lang="picat">go => |
|||
println(ethiopian(17,34)), |
|||
ethiopian2(17,34,Z2), |
|||
println(Z2), |
|||
println(ethiopian(17,34,true)), |
|||
_ = random2(), |
|||
_ = ethiopian(random() mod 10000,random() mod 10000,true), |
|||
nl.</syntaxhighlight> |
|||
{{out}} |
|||
<pre>578 |
|||
578 |
|||
17 * 34: |
|||
17 34 |
|||
8 -- |
|||
4 -- |
|||
2 -- |
|||
1 544 |
|||
======= |
|||
578 |
|||
578 |
|||
5516 * 9839: |
|||
5516 -- |
|||
2758 -- |
|||
1379 39356 |
|||
689 78712 |
|||
344 -- |
|||
172 -- |
|||
86 -- |
|||
43 1259392 |
|||
21 2518784 |
|||
10 -- |
|||
5 10075136 |
|||
2 -- |
|||
1 40300544 |
|||
======= |
|||
54271924</pre> |
|||
=={{header|PicoLisp}}== |
|||
<syntaxhighlight lang="picolisp">(de halve (N) |
|||
(/ N 2) ) |
|||
(de double (N) |
|||
(* N 2) ) |
|||
(de even? (N) |
|||
(not (bit? 1 N)) ) |
|||
(de ethiopian (X Y) |
|||
(let R 0 |
|||
(while (>= X 1) |
|||
(or (even? X) (inc 'R Y)) |
|||
(setq |
|||
X (halve X) |
|||
Y (double Y) ) ) |
|||
R ) )</syntaxhighlight> |
|||
=={{header|Pike}}== |
|||
<syntaxhighlight lang="pike">int ethopian_multiply(int l, int r) |
|||
{ |
|||
int halve(int n) { return n/2; }; |
|||
int double(int n) { return n*2; }; |
|||
int(0..1) evenp(int n) { return !(n%2); }; |
|||
int product = 0; |
|||
do |
|||
{ |
|||
write("%5d %5d\n", l, r); |
|||
if (!evenp(l)) |
|||
product += r; |
|||
l = halve(l); |
|||
r = double(r); |
|||
} |
|||
while(l); |
|||
return product; |
|||
}</syntaxhighlight> |
|||
=={{header|PL/I}}== |
|||
<syntaxhighlight lang="pl/i"> |
|||
declare (L(30), R(30)) fixed binary; |
|||
declare (i, s) fixed binary; |
|||
L, R = 0; |
|||
put skip list |
|||
('Hello, please type two values and I will print their product:'); |
|||
get list (L(1), R(1)); |
|||
put edit ('The product of ', trim(L(1)), ' and ', trim(R(1)), ' is ') (a); |
|||
do i = 1 by 1 while (L(i) ^= 0); |
|||
L(i+1) = halve(L(i)); |
|||
R(i+1) = double(R(i)); |
|||
end; |
|||
s = 0; |
|||
do i = 1 by 1 while (L(i) > 0); |
|||
if odd(L(i)) then s = s + R(i); |
|||
end; |
|||
put edit (trim(s)) (a); |
|||
halve: procedure (k) returns (fixed binary); |
|||
declare k fixed binary; |
|||
return (k/2); |
|||
end halve; |
|||
double: procedure (k) returns (fixed binary); |
|||
declare k fixed binary; |
|||
return (2*k); |
|||
end; |
|||
odd: procedure (k) returns (bit (1)); |
|||
return (iand(k, 1) ^= 0); |
|||
end odd;</syntaxhighlight> |
|||
=={{header|PL/M}}== |
|||
{{Trans|Action!}} |
|||
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator) |
|||
<syntaxhighlight lang="plm"> |
|||
100H: /* ETHIOPIAN MULTIPLICATION */ |
|||
/* CP/M SYSTEM CALL AND I/O ROUTINES */ |
|||
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END; |
|||
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END; |
|||
PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END; |
|||
PR$NL: PROCEDURE; CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END; |
|||
PR$NUMBER: PROCEDURE( N ); /* PRINTS A NUMBER IN THE MINIMUN FIELD WIDTH */ |
|||
DECLARE N ADDRESS; |
|||
DECLARE V ADDRESS, N$STR ( 6 )BYTE, W BYTE; |
|||
V = N; |
|||
W = LAST( N$STR ); |
|||
N$STR( W ) = '$'; |
|||
N$STR( W := W - 1 ) = '0' + ( V MOD 10 ); |
|||
DO WHILE( ( V := V / 10 ) > 0 ); |
|||
N$STR( W := W - 1 ) = '0' + ( V MOD 10 ); |
|||
END; |
|||
CALL PR$STRING( .N$STR( W ) ); |
|||
END PR$NUMBER; |
|||
/* RETURNS THE RESULT OF A * B USING ETHOPIAN MULTIPLICATION */ |
|||
ETHIOPIAN$MULTIPLICATION: PROCEDURE( A, B )ADDRESS; |
|||
DECLARE ( A, B ) ADDRESS; |
|||
DECLARE RES ADDRESS; |
|||
CALL PR$STRING( .'ETHIOPIAN MULTIPLICATION OF $' ); |
|||
CALL PR$NUMBER( A ); |
|||
CALL PR$STRING( .' BY $' ); |
|||
CALL PR$NUMBER( B ); |
|||
CALL PR$NL; |
|||
RES = 0; |
|||
DO WHILE A >= 1; |
|||
CALL PR$NUMBER( A ); |
|||
CALL PR$CHAR( ' ' ); |
|||
CALL PR$NUMBER( B ); |
|||
IF A MOD 2 = 0 THEN DO; |
|||
CALL PR$STRING( .' STRIKE$' ); |
|||
END; |
|||
ELSE DO; |
|||
CALL PR$STRING( .' KEEP$' ); |
|||
RES = RES + B; |
|||
END; |
|||
CALL PR$NL; |
|||
A = SHR( A, 1 ); |
|||
B = SHL( B, 1 ); |
|||
END; |
|||
RETURN( RES ); |
|||
END ETHIOPIAN$MULTIPLICATION; |
|||
DECLARE RES ADDRESS; |
|||
RES = ETHIOPIAN$MULTIPLICATION( 17, 34 ); |
|||
CALL PR$STRING( .'RESULT IS $' ); |
|||
CALL PR$NUMBER( RES ); |
|||
EOF |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
ETHIOPIAN MULTIPLICATION OF 17 BY 34 |
|||
17 34 KEEP |
|||
8 68 STRIKE |
|||
4 136 STRIKE |
|||
2 272 STRIKE |
|||
1 544 KEEP |
|||
RESULT IS 578 |
|||
</pre> |
|||
=={{header|PL/SQL}}== |
=={{header|PL/SQL}}== |
||
This code was taken from the ADA example above - very minor differences. |
This code was taken from the ADA example above - very minor differences. |
||
<syntaxhighlight lang="plsql">create or replace package ethiopian is |
|||
<lang plsql> |
|||
create or replace package ethiopian is |
|||
function multiply |
function multiply |
||
Line 1,011: | Line 5,075: | ||
temp := temp + plicand; |
temp := temp + plicand; |
||
end if; |
end if; |
||
exit when plier <= 1; |
|||
plier := half(plier); |
plier := half(plier); |
||
plicand := double(plicand); |
plicand := double(plicand); |
||
exit when plier <= 1; |
|||
end loop; |
end loop; |
||
temp := temp + plicand; |
|||
return temp; |
return temp; |
||
Line 1,029: | Line 5,091: | ||
dbms_output.put_line(ethiopian.multiply(17, 34)); |
dbms_output.put_line(ethiopian.multiply(17, 34)); |
||
end; |
end; |
||
/</syntaxhighlight> |
|||
/ |
|||
</lang> |
|||
=={{header|Plain English}}== |
|||
<syntaxhighlight lang="plainenglish">\All required helper routines already exist in Plain English: |
|||
\ |
|||
\To cut a number in half: |
|||
\Divide the number by 2. |
|||
\ |
|||
\To double a number: |
|||
\Add the number to the number. |
|||
\ |
|||
\To decide if a number is odd: |
|||
\Privatize the number. |
|||
\Bitwise and the number with 1. |
|||
\If the number is 0, say no. |
|||
\Say yes. |
|||
To run: |
|||
Start up. |
|||
Put 17 into a number. |
|||
Multiply the number by 34 (Ethiopian). |
|||
Convert the number to a string. |
|||
Write the string to the console. |
|||
Wait for the escape key. |
|||
Shut down. |
|||
To multiply a number by another number (Ethiopian): |
|||
Put 0 into a sum number. |
|||
Loop. |
|||
If the number is 0, break. |
|||
If the number is odd, add the other number to the sum. |
|||
Cut the number in half. |
|||
Double the other number. |
|||
Repeat. |
|||
Put the sum into the number.</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
578 |
|||
</pre> |
|||
=={{header|Powerbuilder}}== |
|||
<syntaxhighlight lang="powerbuilder">public function boolean wf_iseven (long al_arg);return mod(al_arg, 2 ) = 0 |
|||
end function |
|||
public function long wf_halve (long al_arg);RETURN int(al_arg / 2) |
|||
end function |
|||
public function long wf_double (long al_arg);RETURN al_arg * 2 |
|||
end function |
|||
public function long wf_ethiopianmultiplication (long al_multiplicand, long al_multiplier);// calculate result |
|||
=={{header|PL/pgSQL}}== |
|||
long ll_product |
|||
{{incorrect|PL/pgSQL|The example is to have separate functions for doubling, halving, and checking if a number is even.}} |
|||
Everything encapsulated in one function. |
|||
DO WHILE al_multiplicand >= 1 |
|||
<lang plpgsql> |
|||
IF wf_iseven(al_multiplicand) THEN |
|||
CREATE OR REPLACE FUNCTION ethiopian_multiplication(multiplier int, multiplicant int) RETURNS int AS $BODY$ |
|||
// do nothing |
|||
-- works at least on PostgreSQL 8.3, should work in older versions as well |
|||
ELSE |
|||
DECLARE |
|||
ll_product += al_multiplier |
|||
sum integer := 0; |
|||
END IF |
|||
plier integer := abs(multiplier); |
|||
al_multiplicand = wf_halve(al_multiplicand) |
|||
plicant integer := abs(multiplicant); |
|||
al_multiplier = wf_double(al_multiplier) |
|||
BEGIN |
|||
LOOP |
|||
-- handling 0 values |
|||
IF (multiplier = 0 OR multiplicant = 0) THEN |
|||
RAISE NOTICE 'One operand is 0. Result 0.'; |
|||
RETURN 0; |
|||
END IF; |
|||
-- running until left operand equals 1 |
|||
WHILE plier >= 1 LOOP |
|||
-- is left operand even? |
|||
IF plier % 2 = 0 THEN |
|||
-- yes, strike this row |
|||
RAISE NOTICE '%, % STRIKE', plier, plicant; |
|||
ELSE |
|||
-- no, add this row to sum |
|||
RAISE NOTICE '%, % KEEP', plier, plicant; |
|||
sum = sum + plicant; |
|||
END IF; |
|||
-- halve left argument |
|||
plier = floor(plier/2); |
|||
-- double left argument |
|||
plicant = plicant*2; |
|||
END LOOP; |
|||
-- handling negative arguments |
|||
IF (multiplier < 0 AND multiplicant > 0) OR (multiplier > 0 AND multiplicant < 0) THEN |
|||
RAISE NOTICE 'Handling negative operands. Invert result.'; |
|||
sum = 0 - sum; |
|||
END IF; |
|||
RETURN sum; |
|||
END; |
|||
$BODY$ LANGUAGE 'plpgsql'; |
|||
</lang> |
|||
return ll_product |
|||
<lang sql> |
|||
end function |
|||
SELECT ethiopian_multiplication(17, 34); |
|||
</lang> |
|||
// example call |
|||
<lang text> |
|||
long ll_answer |
|||
NOTICE: 17, 34 KEEP |
|||
ll_answer = wf_ethiopianmultiplication(17,34)</syntaxhighlight> |
|||
NOTICE: 8, 68 STRIKE |
|||
NOTICE: 4, 136 STRIKE |
|||
NOTICE: 2, 272 STRIKE |
|||
NOTICE: 1, 544 KEEP |
|||
ethiopian_multiplication |
|||
-------------------------- |
|||
578 |
|||
(1 row) |
|||
</lang> |
|||
=={{header|PowerShell}}== |
=={{header|PowerShell}}== |
||
===Traditional=== |
|||
<lang PowerShell> |
|||
function isEven { |
<syntaxhighlight lang="powershell">function isEven { |
||
param ([int]$value) |
param ([int]$value) |
||
return [bool]($value % 2 -eq 0) |
return [bool]($value % 2 -eq 0) |
||
Line 1,129: | Line 5,197: | ||
} |
} |
||
multiplyValues 17 34 |
multiplyValues 17 34</syntaxhighlight> |
||
===Pipes with Busywork=== |
|||
</lang> |
|||
This uses several PowerShell specific features, in functions everything is returned automatically, so explicitly stating return is unnecessary. type conversion happens automatically for certain types, [int] into [boolean] maps 0 to false and everything else to true. A hash is used to store the values as they are being written, then a pipeline is used to iterate over the keys of the hash, determine which are odd, and only sum those. The three-valued ForEach-Object is used to set a start expression, an iterative expression, and a return expression. |
|||
<syntaxhighlight lang="powershell">function halveInt( [int] $rhs ) |
|||
{ |
|||
[math]::floor( $rhs / 2 ) |
|||
} |
|||
function doubleInt( [int] $rhs ) |
|||
{ |
|||
$rhs*2 |
|||
} |
|||
function isEven( [int] $rhs ) |
|||
{ |
|||
-not ( $_ % 2 ) |
|||
} |
|||
function Ethiopian( [int] $lhs , [int] $rhs ) |
|||
{ |
|||
$scratch = @{} |
|||
1..[math]::floor( [math]::log( $lhs , 2 ) + 1 ) | |
|||
ForEach-Object { |
|||
$scratch[$lhs] = $rhs |
|||
$lhs |
|||
$lhs = halveInt( $lhs ) |
|||
$rhs = doubleInt( $rhs ) } | |
|||
Where-Object { -not ( isEven $_ ) } | |
|||
ForEach-Object { $sum = 0 } { $sum += $scratch[$_] } { $sum } |
|||
} |
|||
Ethiopian 17 34</syntaxhighlight> |
|||
=={{header|Prolog}}== |
|||
=== Traditional === |
|||
<syntaxhighlight lang="prolog">halve(X,Y) :- Y is X // 2. |
|||
double(X,Y) :- Y is 2*X. |
|||
is_even(X) :- 0 is X mod 2. |
|||
% columns(First,Second,Left,Right) is true if integers First and Second |
|||
% expand into the columns Left and Right, respectively |
|||
columns(1,Second,[1],[Second]). |
|||
columns(First,Second,[First|Left],[Second|Right]) :- |
|||
halve(First,Halved), |
|||
double(Second,Doubled), |
|||
columns(Halved,Doubled,Left,Right). |
|||
% contribution(Left,Right,Amount) is true if integers Left and Right, |
|||
% from their respective columns contribute Amount to the final sum. |
|||
contribution(Left,_Right,0) :- |
|||
is_even(Left). |
|||
contribution(Left,Right,Right) :- |
|||
\+ is_even(Left). |
|||
ethiopian(First,Second,Product) :- |
|||
columns(First,Second,Left,Right), |
|||
maplist(contribution,Left,Right,Contributions), |
|||
sumlist(Contributions,Product).</syntaxhighlight> |
|||
=== Functional Style === |
|||
Using the same definitions as above for "halve/2", "double/2" and "is_even/2" along with an SWI-Prolog [http://www.swi-prolog.org/pack/list?p=func pack for function notation], one might write the following solution |
|||
<syntaxhighlight lang="prolog">:- use_module(library(func)). |
|||
% halve/2, double/2, is_even/2 definitions go here |
|||
ethiopian(First,Second,Product) :- |
|||
ethiopian(First,Second,0,Product). |
|||
ethiopian(1,Second,Sum0,Sum) :- |
|||
Sum is Sum0 + Second. |
|||
ethiopian(First,Second,Sum0,Sum) :- |
|||
Sum1 is Sum0 + Second*(First mod 2), |
|||
ethiopian(halve $ First, double $ Second, Sum1, Sum).</syntaxhighlight> |
|||
=== Constraint Handling Rules === |
|||
This is a CHR solution for this problem using Prolog as the host language. Code will work in SWI-Prolog and YAP (and possibly in others with or without some minor tweaking). |
|||
<syntaxhighlight lang="prolog">:- module(ethiopia, [test/0, mul/3]). |
|||
:- use_module(library(chr)). |
|||
:- chr_constraint mul/3, halve/2, double/2, even/1, add_odd/4. |
|||
mul(1, Y, S) <=> S = Y. |
|||
mul(X, Y, S) <=> X \= 1 | halve(X, X1), |
|||
double(Y, Y1), |
|||
mul(X1, Y1, S1), |
|||
add_odd(X, Y, S1, S). |
|||
halve(X, Y) <=> Y is X // 2. |
|||
double(X, Y) <=> Y is X * 2. |
|||
even(X) <=> 0 is X mod 2 | true. |
|||
even(X) <=> 1 is X mod 2 | false. |
|||
add_odd(X, _, A, S) <=> even(X) | S is A. |
|||
add_odd(X, Y, A, S) <=> \+ even(X) | S is A + Y. |
|||
test :- |
|||
mul(17, 34, Z), !, |
|||
writeln(Z).</syntaxhighlight>Note that the task statement is what makes the halve and double constraints required. Their use is highly artificial and a more realistic implementation would look like this: |
|||
<syntaxhighlight lang="prolog">:- module(ethiopia, [test/0, mul/3]). |
|||
:- use_module(library(chr)). |
|||
:- chr_constraint mul/3, even/1, add_if_odd/4. |
|||
mul(1, Y, S) <=> S = Y. |
|||
mul(X, Y, S) <=> X \= 1 | X1 is X // 2, |
|||
Y1 is Y * 2, |
|||
mul(X1, Y1, S1), |
|||
add_if_odd(X, Y, S1, S). |
|||
even(X) <=> 0 is X mod 2 | true. |
|||
even(X) <=> 1 is X mod 2 | false. |
|||
add_if_odd(X, _, A, S) <=> even(X) | S is A. |
|||
add_if_odd(X, Y, A, S) <=> \+ even(X) | S is A + Y. |
|||
test :- |
|||
mul(17, 34, Z), |
|||
writeln(Z).</syntaxhighlight>Even this is more verbose than what a more native solution would look like. |
|||
=={{header|Python}}== |
=={{header|Python}}== |
||
===Python: With tutor=== |
|||
<lang python> |
|||
tutor = True |
<syntaxhighlight lang="python">tutor = True |
||
def halve(x): |
def halve(x): |
||
return x//2 |
return x // 2 |
||
def double(x): |
def double(x): |
||
return x*2 |
return x * 2 |
||
def even(x): |
def even(x): |
||
Line 1,147: | Line 5,343: | ||
def ethiopian(multiplier, multiplicand): |
def ethiopian(multiplier, multiplicand): |
||
if tutor: |
if tutor: |
||
print( |
print("Ethiopian multiplication of %i and %i" % |
||
(multiplier, multiplicand)) |
|||
result = 0 |
result = 0 |
||
while multiplier >= 1: |
while multiplier >= 1: |
||
if even(multiplier): |
if even(multiplier): |
||
if tutor: |
if tutor: |
||
print("%4i %6i STRUCK" % |
|||
(multiplier, multiplicand)) |
|||
else: |
else: |
||
if tutor: |
if tutor: |
||
print("%4i %6i KEPT" % |
|||
(multiplier, multiplicand)) |
|||
result += multiplicand |
result += multiplicand |
||
multiplier = halve(multiplier) |
multiplier = halve(multiplier) |
||
multiplicand = double(multiplicand) |
multiplicand = double(multiplicand) |
||
if tutor: |
if tutor: |
||
print() |
|||
return result</syntaxhighlight> |
|||
</lang> |
|||
Sample output |
Sample output |
||
Line 1,176: | Line 5,374: | ||
578 |
578 |
||
>>> |
>>></pre> |
||
===Python: Without tutor=== |
|||
Without the tutorial code, and taking advantage of Python's lambda: |
Without the tutorial code, and taking advantage of Python's lambda: |
||
<syntaxhighlight lang="python">halve = lambda x: x // 2 |
|||
<lang python> |
|||
halve = lambda x: x // 2 |
|||
double = lambda x: x*2 |
double = lambda x: x*2 |
||
even = lambda x |
even = lambda x: not x % 2 |
||
def ethiopian(multiplier, multiplicand): |
def ethiopian(multiplier, multiplicand): |
||
Line 1,191: | Line 5,389: | ||
if not even(multiplier): |
if not even(multiplier): |
||
result += multiplicand |
result += multiplicand |
||
multiplier = halve(multiplier) |
multiplier = halve(multiplier) |
||
multiplicand = double(multiplicand) |
multiplicand = double(multiplicand) |
||
return result |
return result</syntaxhighlight> |
||
</lang> |
|||
===Python: With tutor. More Functional=== |
|||
Using some features which Python has for use in functional programming. The example also tries to show how to mix different programming styles while keeping close to the task specification, a kind of "executable pseudocode". Note: While column2 could theoretically generate a sequence of infinite length, izip will stop requesting values from it (and so provide the necessary stop condition) when column1 has no more values. When not using the tutor, table will generate the table on the fly in an efficient way, not keeping any intermediate values.<syntaxhighlight lang="python">tutor = True |
|||
from itertools import izip, takewhile |
|||
def iterate(function, arg): |
|||
while 1: |
|||
yield arg |
|||
arg = function(arg) |
|||
def halve(x): return x // 2 |
|||
def double(x): return x * 2 |
|||
def even(x): return x % 2 == 0 |
|||
def show_heading(multiplier, multiplicand): |
|||
print "Multiplying %d by %d" % (multiplier, multiplicand), |
|||
print "using Ethiopian multiplication:" |
|||
print |
|||
TABLE_FORMAT = "%8s %8s %8s %8s %8s" |
|||
def show_table(table): |
|||
for p, q in table: |
|||
print TABLE_FORMAT % (p, q, "->", |
|||
p, q if not even(p) else "-" * len(str(q))) |
|||
def show_result(result): |
|||
print TABLE_FORMAT % ('', '', '', '', "=" * (len(str(result)) + 1)) |
|||
print TABLE_FORMAT % ('', '', '', '', result) |
|||
def ethiopian(multiplier, multiplicand): |
|||
def column1(x): return takewhile(lambda v: v >= 1, iterate(halve, x)) |
|||
def column2(x): return iterate(double, x) |
|||
def rows(x, y): return izip(column1(x), column2(y)) |
|||
table = rows(multiplier, multiplicand) |
|||
if tutor: |
|||
table = list(table) |
|||
show_heading(multiplier, multiplicand) |
|||
show_table(table) |
|||
result = sum(q for p, q in table if not even(p)) |
|||
if tutor: |
|||
show_result(result) |
|||
return result</syntaxhighlight>{{out|Example output}} |
|||
>>> ethiopian(17, 34) |
|||
Multiplying 17 by 34 using Ethiopian multiplication: |
|||
17 34 -> 17 34 |
|||
8 68 -> 8 -- |
|||
4 136 -> 4 --- |
|||
2 272 -> 2 --- |
|||
1 544 -> 1 544 |
|||
==== |
|||
578 |
|||
578 |
|||
===Python: as an unfold followed by a fold=== |
|||
{{Trans|Haskell}} |
|||
{{Works with|Python|3.7}} |
|||
Avoiding the use of the multiplication operator, and defining a catamorphism applied over an anamorphism. |
|||
<syntaxhighlight lang="python">'''Ethiopian multiplication''' |
|||
from functools import reduce |
|||
# ethMult :: Int -> Int -> Int |
|||
def ethMult(n): |
|||
'''Ethiopian multiplication of n by m.''' |
|||
def doubled(x): |
|||
return x + x |
|||
def halved(h): |
|||
qr = divmod(h, 2) |
|||
if 0 < h: |
|||
print('halve:', str(qr).rjust(8, ' ')) |
|||
return qr if 0 < h else None |
|||
def addedWhereOdd(a, remx): |
|||
odd, x = remx |
|||
if odd: |
|||
print( |
|||
str(a).rjust(2, ' '), '+', |
|||
str(x).rjust(3, ' '), '->', |
|||
str(a + x).rjust(3, ' ') |
|||
) |
|||
return a + x |
|||
else: |
|||
print(str(x).rjust(8, ' ')) |
|||
return a |
|||
return lambda m: reduce( |
|||
addedWhereOdd, |
|||
zip( |
|||
unfoldr(halved)(n), |
|||
iterate(doubled)(m) |
|||
), |
|||
0 |
|||
) |
|||
# ------------------------- TEST ------------------------- |
|||
def main(): |
|||
'''Tests of multiplication.''' |
|||
print( |
|||
'\nProduct: ' + str( |
|||
ethMult(17)(34) |
|||
), |
|||
'\n_______________\n' |
|||
) |
|||
print( |
|||
'\nProduct: ' + str( |
|||
ethMult(34)(17) |
|||
) |
|||
) |
|||
# ----------------------- GENERIC ------------------------ |
|||
# iterate :: (a -> a) -> a -> Gen [a] |
|||
def iterate(f): |
|||
'''An infinite list of repeated |
|||
applications of f to x. |
|||
''' |
|||
def go(x): |
|||
v = x |
|||
while True: |
|||
yield v |
|||
v = f(v) |
|||
return go |
|||
# showLog :: a -> IO String |
|||
def showLog(*s): |
|||
'''Arguments printed with |
|||
intercalated arrows.''' |
|||
print( |
|||
' -> '.join(map(str, s)) |
|||
) |
|||
# unfoldr :: (b -> Maybe (a, b)) -> b -> [a] |
|||
def unfoldr(f): |
|||
'''Dual to reduce or foldr. |
|||
Where catamorphism reduces a list to a summary value, |
|||
the anamorphic unfoldr builds a list from a seed value. |
|||
As long as f returns Just(a, b), a is prepended to the list, |
|||
and the residual b is used as the argument for the next |
|||
application of f. |
|||
When f returns Nothing, the completed list is returned.''' |
|||
def go(v): |
|||
xr = v, v |
|||
xs = [] |
|||
while True: |
|||
xr = f(xr[0]) |
|||
if xr: |
|||
xs.append(xr[1]) |
|||
else: |
|||
return xs |
|||
return xs |
|||
return go |
|||
# MAIN --- |
|||
if __name__ == '__main__': |
|||
main() |
|||
</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>halve: (8, 1) |
|||
halve: (4, 0) |
|||
halve: (2, 0) |
|||
halve: (1, 0) |
|||
halve: (0, 1) |
|||
0 + 34 -> 34 |
|||
68 |
|||
136 |
|||
272 |
|||
34 + 544 -> 578 |
|||
Product: 578 |
|||
_______________ |
|||
halve: (17, 0) |
|||
halve: (8, 1) |
|||
halve: (4, 0) |
|||
halve: (2, 0) |
|||
halve: (1, 0) |
|||
halve: (0, 1) |
|||
17 |
|||
0 + 34 -> 34 |
|||
68 |
|||
136 |
|||
272 |
|||
34 + 544 -> 578 |
|||
Product: 578</pre> |
|||
=={{header|Quackery}}== |
|||
{{Trans|Forth}} |
|||
Extended to handle negative numbers. |
|||
<syntaxhighlight lang="quackery">[ 1 & not ] is even ( n --> b ) |
|||
[ 1 << ] is double ( n --> n ) |
|||
[ 1 >> ] is halve ( n --> n ) |
|||
[ dup 0 < unrot abs |
|||
[ dup 0 = iff nip done |
|||
over double over halve |
|||
recurse |
|||
swap even |
|||
iff nip else + ] |
|||
swap if negate ] is e* ( n n --> n )</syntaxhighlight> |
|||
=={{header|R}}== |
=={{header|R}}== |
||
===R: With tutor=== |
|||
<lang R>halve <- function(a) floor(a/2) |
|||
<syntaxhighlight lang="r">halve <- function(a) floor(a/2) |
|||
double <- function(a) a*2 |
double <- function(a) a*2 |
||
iseven <- function(a) (a%%2)==0 |
iseven <- function(a) (a%%2)==0 |
||
Line 1,216: | Line 5,632: | ||
} |
} |
||
print(ethiopicmult(17, 34, TRUE))</ |
print(ethiopicmult(17, 34, TRUE))</syntaxhighlight> |
||
===R: Without tutor=== |
|||
Another interesting implementation could be |
|||
Simplified version. |
|||
{{incorrect|R|The task specifies that examples should have separate functions for doubling, halving, and checking if a number is even.}} |
|||
<syntaxhighlight lang="r"> |
|||
<lang R>ethiopicmult <- function(a, b) { |
|||
halve <- function(a) floor(a/2) |
|||
double <- function(a) a*2 |
|||
iseven <- function(a) (a%%2)==0 |
|||
while( plier[ length(plier) ] > 1 ) { |
|||
plier <- c(plier, floor(plier[length(plier)]/2)) |
|||
ethiopicmult<-function(x,y){ |
|||
plicand <- c(plicand, plicand[length(plicand)]*2) |
|||
res<-ifelse(iseven(y),0,x) |
|||
} |
|||
while(!y==1){ |
|||
return( sum(plicand[ plier %% 2 != 0]) ) |
|||
x<-double(x) |
|||
}</lang> |
|||
y<-halve(y) |
|||
if(!iseven(y)) res<-res+x |
|||
} |
|||
return(res) |
|||
} |
|||
print(ethiopicmult(17,34)) |
|||
</syntaxhighlight> |
|||
=={{header|Racket}}== |
|||
<syntaxhighlight lang="racket">#lang racket |
|||
(define (halve i) (quotient i 2)) |
|||
(define (double i) (* i 2)) |
|||
;; `even?' is built-in |
|||
(define (ethiopian-multiply x y) |
|||
(cond [(zero? x) 0] |
|||
[(even? x) (ethiopian-multiply (halve x) (double y))] |
|||
[else (+ y (ethiopian-multiply (halve x) (double y)))])) |
|||
(ethiopian-multiply 17 34) ; -> 578</syntaxhighlight> |
|||
=={{header|Raku}}== |
|||
(formerly Perl 6) |
|||
<syntaxhighlight lang="raku" line>sub halve (Int $n is rw) { $n div= 2 } |
|||
sub double (Int $n is rw) { $n *= 2 } |
|||
sub even (Int $n --> Bool) { $n %% 2 } |
|||
sub ethiopic-mult (Int $a is copy, Int $b is copy --> Int) { |
|||
my Int $r = 0; |
|||
while $a { |
|||
even $a or $r += $b; |
|||
halve $a; |
|||
double $b; |
|||
} |
|||
return $r; |
|||
} |
|||
say ethiopic-mult(17,34);</syntaxhighlight> |
|||
{{out}} |
|||
578 |
|||
More succinctly using implicit typing, primed lambdas, and an infinite loop: |
|||
<syntaxhighlight lang="raku" line>sub ethiopic-mult { |
|||
my &halve = * div= 2; |
|||
my &double = * *= 2; |
|||
my &even = * %% 2; |
|||
my ($a,$b) = @_; |
|||
my $r; |
|||
loop { |
|||
even $a or $r += $b; |
|||
halve $a or return $r; |
|||
double $b; |
|||
} |
|||
} |
|||
say ethiopic-mult(17,34);</syntaxhighlight> |
|||
More succinctly still, using a pure functional approach (reductions, mappings, lazy infinite sequences): |
|||
<syntaxhighlight lang="raku" line>sub halve { $^n div 2 } |
|||
sub double { $^n * 2 } |
|||
sub even { $^n %% 2 } |
|||
sub ethiopic-mult ($a, $b) { |
|||
[+] ($b, &double ... *) |
|||
Z* |
|||
($a, &halve ... 0).map: { not even $^n } |
|||
} |
|||
say ethiopic-mult(17,34);</syntaxhighlight>(same output) |
|||
=={{header|Rascal}}== |
|||
<syntaxhighlight lang="rascal">import IO; |
|||
public int halve(int n) = n/2; |
|||
public int double(int n) = n*2; |
|||
public bool uneven(int n) = (n % 2) != 0); |
|||
public int ethiopianMul(int n, int m) { |
|||
result = 0; |
|||
while(n >= 1) { |
|||
if(uneven(n)) |
|||
result += m; |
|||
n = halve(n); |
|||
m = double(m); |
|||
} |
|||
return result; |
|||
} </syntaxhighlight> |
|||
=={{header|Red}}== |
|||
<syntaxhighlight lang="rebol">Red["Ethiopian multiplication"] |
|||
halve: function [n][n >> 1] |
|||
double: function [n][n << 1] |
|||
;== even? already exists |
|||
ethiopian-multiply: function [ |
|||
"Returns the product of two integers using Ethiopian multiplication" |
|||
a [integer!] "The multiplicand" |
|||
b [integer!] "The multiplier" |
|||
][ |
|||
result: 0 |
|||
while [a <> 0][ |
|||
if odd? a [result: result + b] |
|||
a: halve a |
|||
b: double b |
|||
] |
|||
result |
|||
] |
|||
print ethiopian-multiply 17 34</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
578 |
|||
</pre> |
|||
=={{header|Relation}}== |
|||
<syntaxhighlight lang="relation"> |
|||
function half(x) |
|||
set result = floor(x/2) |
|||
end function |
|||
function double(x) |
|||
set result = 2*x |
|||
end function |
|||
function even(x) |
|||
set result = (x/2 > floor(x/2)) |
|||
end function |
|||
program ethiopian_mul(a,b) |
|||
relation first, second |
|||
while a >= 1 |
|||
insert a, b |
|||
set a = half(a) |
|||
set b = double(b) |
|||
end while |
|||
extend third = even(first) * second |
|||
project third sum |
|||
end program |
|||
run ethiopian_mul(17,34) |
|||
print |
|||
</syntaxhighlight> |
|||
=={{header|REXX}}== |
|||
These two REXX versions properly handle negative integers. |
|||
===sans error checking=== |
|||
<syntaxhighlight lang="rexx">/*REXX program multiplies two integers by the Ethiopian (or Russian peasant) method. */ |
|||
numeric digits 3000 /*handle some gihugeic integers. */ |
|||
parse arg a b . /*get two numbers from the command line*/ |
|||
say 'a=' a /*display a formatted value of A. */ |
|||
say 'b=' b /* " " " " " B. */ |
|||
say 'product=' eMult(a, b) /*invoke eMult & multiple two integers.*/ |
|||
exit /*stick a fork in it, we're all done. */ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
eMult: procedure; parse arg x,y; s=sign(x) /*obtain the two arguments; sign for X.*/ |
|||
$=0 /*product of the two integers (so far).*/ |
|||
do while x\==0 /*keep processing while X not zero.*/ |
|||
if \isEven(x) then $=$+y /*if odd, then add Y to product. */ |
|||
x= halve(x) /*invoke the HALVE function. */ |
|||
y=double(y) /* " " DOUBLE " */ |
|||
end /*while*/ /* [↑] Ethiopian multiplication method*/ |
|||
return $*s/1 /*maintain the correct sign for product*/ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
double: return arg(1) * 2 /* * is REXX's multiplication. */ |
|||
halve: return arg(1) % 2 /* % " " integer division. */ |
|||
isEven: return arg(1) // 2 == 0 /* // " " division remainder.*/</syntaxhighlight> |
|||
'''output''' when the following input is used: <tt> 30 -7 </tt> |
|||
<pre> |
|||
a= 30 |
|||
b= -7 |
|||
product= -210 |
|||
</pre> |
|||
===with error checking=== |
|||
This REXX version also aligns the "input" messages and also performs some basic error checking. |
|||
Note that the 2<sup>nd</sup> number needn't be an integer, any valid number will work. |
|||
<syntaxhighlight lang="rexx">/*REXX program multiplies two integers by the Ethiopian (or Russian peasant) method. */ |
|||
numeric digits 3000 /*handle some gihugeic integers. */ |
|||
parse arg a b _ . /*get two numbers from the command line*/ |
|||
if a=='' then call error "1st argument wasn't specified." |
|||
if b=='' then call error "2nd argument wasn't specified." |
|||
if _\=='' then call error "too many arguments were specified: " _ |
|||
if \datatype(a, 'W') then call error "1st argument isn't an integer: " a |
|||
if \datatype(b, 'N') then call error "2nd argument isn't a valid number: " b |
|||
p=eMult(a, b) /*Ethiopian or Russian peasant method. */ |
|||
w=max(length(a), length(b), length(p)) /*find the maximum width of 3 numbers. */ |
|||
say ' a=' right(a, w) /*use right justification to display A.*/ |
|||
say ' b=' right(b, w) /* " " " " " B.*/ |
|||
say 'product=' right(p, w) /* " " " " " P.*/ |
|||
exit /*stick a fork in it, we're all done. */ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
eMult: procedure; parse arg x,y; s=sign(x) /*obtain the two arguments; sign for X.*/ |
|||
$=0 /*product of the two integers (so far).*/ |
|||
do while x\==0 /*keep processing while X not zero.*/ |
|||
if \isEven(x) then $=$+y /*if odd, then add Y to product. */ |
|||
x= halve(x) /*invoke the HALVE function. */ |
|||
y=double(y) /* " " DOUBLE " */ |
|||
end /*while*/ /* [↑] Ethiopian multiplication method*/ |
|||
return $*s/1 /*maintain the correct sign for product*/ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
double: return arg(1) * 2 /* * is REXX's multiplication. */ |
|||
halve: return arg(1) % 2 /* % " " integer division. */ |
|||
isEven: return arg(1) // 2 == 0 /* // " " division remainder.*/ |
|||
error: say '***error!***' arg(1); exit 13 /*display an error message to terminal.*/</syntaxhighlight> |
|||
'''output''' when the following input is used: <tt> 200 0.333 </tt> |
|||
<pre> |
|||
a= 200 |
|||
b= 0.333 |
|||
product= 66.6 |
|||
</pre> |
|||
=={{header|Ring}}== |
|||
<syntaxhighlight lang="ring"> |
|||
x = 17 |
|||
y = 34 |
|||
p = 0 |
|||
while x != 0 |
|||
if not even(x) |
|||
p += y |
|||
see "" + x + " " + " " + y + nl |
|||
else |
|||
see "" + x + " ---" + nl ok |
|||
x = halve(x) |
|||
y = double(y) |
|||
end |
|||
see " " + " ===" + nl |
|||
see " " + p |
|||
func double n return (n * 2) |
|||
func halve n return floor(n / 2) |
|||
func even n return ((n & 1) = 0) |
|||
</syntaxhighlight> |
|||
Output: |
|||
<pre> |
|||
17 34 |
|||
8 --- |
|||
4 --- |
|||
2 --- |
|||
1 544 |
|||
=== |
|||
578 |
|||
</pre> |
|||
=={{header|RPL}}== |
|||
Calculations are here made on binary integers, on which built-in instructions <code>SL</code> and <code>SR</code> perform resp. doubling and halving. |
|||
{{works with|Halcyon Calc|4.2.7}} |
|||
{| class="wikitable" |
|||
! RPL code |
|||
! Comment |
|||
|- |
|||
| |
|||
≪ # 1d AND # 0d == |
|||
≫ ''''EVEN?'''' STO |
|||
≪ |
|||
# 0d ROT R→B ROT R→B |
|||
'''WHILE''' OVER # 0d ≠ '''REPEAT''' |
|||
'''IF''' OVER '''EVEN?''' NOT |
|||
'''THEN''' ROT OVER + ROT ROT '''END ''' |
|||
SL SWAP SR SWAP |
|||
'''END''' DROP2 B→R |
|||
≫ ''''ETMUL'''' STO |
|||
| |
|||
'''EVEN?''' ''( #n -- boolean ) '' |
|||
return 1 if n is even, 0 otherwise |
|||
'''ETMUL''' ''( a b -- a*b ) '' |
|||
put accumulator, a and b (converted to integers) in stack |
|||
while b > 0 |
|||
if b is odd |
|||
add a to accumulator |
|||
double a, halve b |
|||
delete a and b and convert a*b to floating point |
|||
|} |
|||
=={{header|Ruby}}== |
=={{header|Ruby}}== |
||
Iterative and recursive implementations here. |
Iterative and recursive implementations here. |
||
I've chosen to highlight the example 20*5 which I think is more illustrative. |
I've chosen to highlight the example 20*5 which I think is more illustrative. |
||
<lang |
<syntaxhighlight lang="ruby">def halve(x) = x/2 |
||
def |
def double(x) = x*2 |
||
def double(x); x*2; end |
|||
# iterative |
# iterative |
||
def |
def ethiopian_multiply(a, b) |
||
product = 0 |
product = 0 |
||
while a >= 1 |
while a >= 1 |
||
p [a, b, |
p [a, b, a.even? ? "STRIKE" : "KEEP"] if $DEBUG |
||
product += b |
product += b unless a.even? |
||
a = halve(a) |
a = halve(a) |
||
b = double(b) |
b = double(b) |
||
Line 1,250: | Line 5,945: | ||
# recursive |
# recursive |
||
def |
def rec_ethiopian_multiply(a, b) |
||
return 0 if a < 1 |
return 0 if a < 1 |
||
p [a, b, |
p [a, b, a.even? ? "STRIKE" : "KEEP"] if $DEBUG |
||
(a.even? ? 0 : b) + rec_ethiopian_multiply(halve(a), double(b)) |
|||
end |
end |
||
$DEBUG = true # $DEBUG also set to true if "-d" option given |
$DEBUG = true # $DEBUG also set to true if "-d" option given |
||
a, b = 20, 5 |
a, b = 20, 5 |
||
puts "#{a} * #{b} = #{ |
puts "#{a} * #{b} = #{ethiopian_multiply(a,b)}"; puts</syntaxhighlight> |
||
{{out}} |
|||
$DEBUG = false |
|||
<pre> |
|||
require 'test/unit' |
|||
[20, 5, "STRIKE"] |
|||
[10, 10, "STRIKE"] |
|||
[5, 20, "KEEP"] |
|||
[2, 40, "STRIKE"] |
|||
[1, 80, "KEEP"] |
|||
20 * 5 = 100</pre> |
|||
A test suite: |
|||
<syntaxhighlight lang="ruby">require 'test/unit' |
|||
class EthiopianTests < Test::Unit::TestCase |
class EthiopianTests < Test::Unit::TestCase |
||
def test_iter1; assert_equal(578, ethopian_multiply(17,34)); end |
def test_iter1; assert_equal(578, ethopian_multiply(17,34)); end |
||
Line 1,275: | Line 5,979: | ||
def test_rec5; assert_equal(0, rec_ethopian_multiply(5,0)); end |
def test_rec5; assert_equal(0, rec_ethopian_multiply(5,0)); end |
||
def test_rec6; assert_equal(0, rec_ethopian_multiply(0,5)); end |
def test_rec6; assert_equal(0, rec_ethopian_multiply(0,5)); end |
||
end</ |
end</syntaxhighlight> |
||
<pre>Run options: |
|||
Output: |
|||
<pre>[20, 5, "STRIKE"] |
|||
# Running tests: |
|||
[10, 10, "STRIKE"] |
|||
[5, 20, "KEEP"] |
|||
[2, 40, "STRIKE"] |
|||
[1, 80, "KEEP"] |
|||
20 * 5 = 100 |
|||
Loaded suite ethopian |
|||
Started |
|||
............ |
............ |
||
Finished in 0. |
Finished tests in 0.014001s, 857.0816 tests/s, 857.0816 assertions/s. |
||
12 tests, 12 assertions, 0 failures, 0 errors |
12 tests, 12 assertions, 0 failures, 0 errors, 0 skips |
||
ruby -v: ruby 2.0.0p247 (2013-06-27) [i386-mingw32] |
|||
</pre> |
|||
=={{header|Rust}}== |
|||
<syntaxhighlight lang="rust">fn double(a: i32) -> i32 { |
|||
2*a |
|||
} |
|||
fn halve(a: i32) -> i32 { |
|||
a/2 |
|||
} |
|||
fn is_even(a: i32) -> bool { |
|||
a % 2 == 0 |
|||
} |
|||
fn ethiopian_multiplication(mut x: i32, mut y: i32) -> i32 { |
|||
let mut sum = 0; |
|||
while x >= 1 { |
|||
print!("{} \t {}", x, y); |
|||
match is_even(x) { |
|||
true => println!("\t Not Kept"), |
|||
false => { |
|||
println!("\t Kept"); |
|||
sum += y; |
|||
} |
|||
} |
|||
x = halve(x); |
|||
y = double(y); |
|||
} |
|||
sum |
|||
} |
|||
fn main() { |
|||
let output = ethiopian_multiplication(17, 34); |
|||
println!("---------------------------------"); |
|||
println!("\t {}", output); |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>17 34 Kept |
|||
8 68 Not Kept |
|||
4 136 Not Kept |
|||
2 272 Not Kept |
|||
1 544 Kept |
|||
--------------------------------- |
|||
578</pre> |
|||
=={{header|S-BASIC}}== |
|||
<syntaxhighlight lang="basic"> |
|||
$constant true = 0FFFFH |
|||
$constant false = 0 |
|||
function half(n = integer) = integer |
|||
end = n / 2 |
|||
function twice(n = integer) = integer |
|||
end = n + n |
|||
rem - return true (-1) if n is even, otherwise false |
|||
function even(n = integer) = integer |
|||
var one = integer |
|||
one = 1 rem - only variables are compared bitwise |
|||
end = ((n and one) = 0) |
|||
rem - return i * j, optionally showing steps |
|||
function ethiopian(i, j, show = integer) = integer |
|||
var p = integer |
|||
p = 0 |
|||
while i >= 1 do |
|||
begin |
|||
if even(i) then |
|||
begin |
|||
if show then print i;" ---";j |
|||
end |
|||
else |
|||
begin |
|||
if show then print i;" ";j;"+" |
|||
p = p + j |
|||
end |
|||
i = half(i) |
|||
j = twice(j) |
|||
end |
|||
if show then |
|||
begin |
|||
print "----------" |
|||
print " ="; |
|||
end |
|||
end = p |
|||
rem - exercise the function |
|||
print "Multiplying 17 times 34" |
|||
print ethiopian(17,34,true) |
|||
end</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Multiplying 17 times 34 |
|||
17 34+ |
|||
8 --- 68 |
|||
4 --- 136 |
|||
2 --- 272 |
|||
1 544+ |
|||
---------- |
|||
= 578</pre> |
|||
=={{header|Scala}}== |
|||
The first and second are only slightly different and use functional style. |
|||
The third uses a for loop to yield the result. |
|||
The fourth uses recursion. |
|||
<syntaxhighlight lang="scala"> |
|||
def ethiopian(i:Int, j:Int):Int= |
|||
pairIterator(i,j).filter(x=> !isEven(x._1)).map(x=>x._2).foldLeft(0){(x,y)=>x+y} |
|||
def ethiopian2(i:Int, j:Int):Int= |
|||
pairIterator(i,j).map(x=>if(isEven(x._1)) 0 else x._2).foldLeft(0){(x,y)=>x+y} |
|||
def ethiopian3(i:Int, j:Int):Int= |
|||
{ |
|||
var res=0; |
|||
for((h,d) <- pairIterator(i,j) if !isEven(h)) res+=d; |
|||
res |
|||
} |
|||
def ethiopian4(i: Int, j: Int): Int = if (i == 1) j else ethiopian(halve(i), double(j)) + (if (isEven(i)) 0 else j) |
|||
def isEven(x:Int)=(x&1)==0 |
|||
def halve(x:Int)=x>>>1 |
|||
def double(x:Int)=x<<1 |
|||
// generates pairs of values (halve,double) |
|||
def pairIterator(x:Int, y:Int)=new Iterator[(Int, Int)] |
|||
{ |
|||
var i=(x, y) |
|||
def hasNext=i._1>0 |
|||
def next={val r=i; i=(halve(i._1), double(i._2)); r} |
|||
} |
|||
</syntaxhighlight> |
|||
=={{header|Scheme}}== |
|||
In Scheme, <code>even?</code> is a standard procedure. |
|||
<syntaxhighlight lang="scheme">(define (halve num) |
|||
(quotient num 2)) |
|||
(define (double num) |
|||
(* num 2)) |
|||
(define (*mul-eth plier plicand acc) |
|||
(cond ((zero? plier) acc) |
|||
((even? plier) (*mul-eth (halve plier) (double plicand) acc)) |
|||
(else (*mul-eth (halve plier) (double plicand) (+ acc plicand))))) |
|||
(define (mul-eth plier plicand) |
|||
(*mul-eth plier plicand 0)) |
|||
(display (mul-eth 17 34)) |
|||
(newline)</syntaxhighlight> |
|||
Output: |
|||
578 |
|||
=={{header|Seed7}}== |
=={{header|Seed7}}== |
||
{{incorrect|Seed7|The task specifies that examples should have separate functions for doubling, halving, and checking if a number is even.}} |
|||
Ethiopian Multiplication is another name for the peasant multiplication: |
Ethiopian Multiplication is another name for the peasant multiplication: |
||
<lang |
<syntaxhighlight lang="seed7">const proc: double (inout integer: a) is func |
||
begin |
|||
a *:= 2; |
|||
end func; |
|||
const proc: halve (inout integer: a) is func |
|||
begin |
|||
a := a div 2; |
|||
end func; |
|||
const func boolean: even (in integer: a) is |
|||
return not odd(a); |
|||
const func integer: peasantMult (in var integer: a, in var integer: b) is func |
|||
result |
result |
||
var integer: result is 0; |
var integer: result is 0; |
||
begin |
begin |
||
while a <> 0 do |
while a <> 0 do |
||
if |
if not even(a) then |
||
result +:= b; |
result +:= b; |
||
end if; |
end if; |
||
a |
halve(a); |
||
b |
double(b); |
||
end while; |
end while; |
||
end func;</ |
end func;</syntaxhighlight> |
||
Original source: [http://seed7.sourceforge.net/algorith/math.htm#peasantMult] |
Original source (without separate functions for doubling, halving, and checking if a number is even): [http://seed7.sourceforge.net/algorith/math.htm#peasantMult] |
||
=={{header|Sidef}}== |
|||
<syntaxhighlight lang="ruby">func double (n) { n << 1 } |
|||
func halve (n) { n >> 1 } |
|||
func isEven (n) { n&1 == 0 } |
|||
func ethiopian_mult(a, b) { |
|||
var r = 0 |
|||
while (a > 0) { |
|||
r += b if !isEven(a) |
|||
a = halve(a) |
|||
b = double(b) |
|||
} |
|||
return r |
|||
} |
|||
say ethiopian_mult(17, 34)</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
578 |
|||
</pre> |
|||
=={{header|Smalltalk}}== |
=={{header|Smalltalk}}== |
||
{{works with|GNU Smalltalk}} |
{{works with|GNU Smalltalk}} |
||
< |
<syntaxhighlight lang="smalltalk">Number extend [ |
||
double [ ^ self * 2 ] |
double [ ^ self * 2 ] |
||
halve [ ^ self // 2 ] |
halve [ ^ self // 2 ] |
||
Line 1,343: | Line 6,235: | ||
] |
] |
||
ethiopianMultiplyBy: aNumber [ ^ self ethiopianMultiplyBy: aNumber withTutor: false ] |
ethiopianMultiplyBy: aNumber [ ^ self ethiopianMultiplyBy: aNumber withTutor: false ] |
||
].</ |
].</syntaxhighlight> |
||
< |
<syntaxhighlight lang="smalltalk">(17 ethiopianMultiplyBy: 34 withTutor: true) displayNl.</syntaxhighlight> |
||
=={{header|SNOBOL4}}== |
|||
<syntaxhighlight lang="snobol4"> |
|||
define('halve(num)') :(halve_end) |
|||
halve eq(num,1) :s(freturn) |
|||
halve = num / 2 :(return) |
|||
halve_end |
|||
define('double(num)') :(double_end) |
|||
double double = num * 2 :(return) |
|||
double_end |
|||
define('odd(num)') :(odd_end) |
|||
odd eq(num,1) :s(return) |
|||
eq(num,double(halve(num))) :s(freturn)f(return) |
|||
odd_end l = trim(input) |
|||
r = trim(input) |
|||
s = 0 |
|||
next s = odd(l) s + r |
|||
r = double(r) |
|||
l = halve(l) :s(next) |
|||
stop output = s |
|||
end</syntaxhighlight> |
|||
=={{header|SNUSP}}== |
|||
<syntaxhighlight lang="snusp"> /==!/==atoi==@@@-@-----# |
|||
| | /-\ /recurse\ #/?\ zero |
|||
$>,@/>,@/?\<=zero=!\?/<=print==!\@\>?!\@/<@\.!\-/ |
|||
< @ # | \=/ \=itoa=@@@+@+++++# |
|||
/==\ \===?!/===-?\>>+# halve ! /+ !/+ !/+ !/+ \ mod10 |
|||
# ! @ | #>>\?-<+>/ /<+> -\!?-\!?-\!?-\!?-\! |
|||
/-<+>\ > ? />+<<++>-\ \?!\-?!\-?!\-?!\-?!\-?/\ div10 |
|||
?down? | \-<<<!\=======?/\ add & # +/! +/! +/! +/! +/ |
|||
\>+<-/ | \=<<<!/====?\=\ | double |
|||
! # | \<++>-/ | | |
|||
\=======\!@>============/!/</syntaxhighlight> |
|||
This is possibly the smallest multiply routine so far discovered for SNUSP. |
|||
=={{header|Soar}}== |
|||
<syntaxhighlight lang="soar">########################################## |
|||
# multiply takes ^left and ^right numbers |
|||
# and a ^return-to |
|||
sp {multiply*elaborate*initialize |
|||
(state <s> ^superstate.operator <o>) |
|||
(<o> ^name multiply |
|||
^left <x> |
|||
^right <y> |
|||
^return-to <r>) |
|||
--> |
|||
(<s> ^name multiply |
|||
^left <x> |
|||
^right <y> |
|||
^return-to <r>)} |
|||
sp {multiply*propose*recurse |
|||
(state <s> ^name multiply |
|||
^left <x> > 0 |
|||
^right <y> |
|||
^return-to <r> |
|||
-^multiply-done) |
|||
--> |
|||
(<s> ^operator <o> +) |
|||
(<o> ^name multiply |
|||
^left (div <x> 2) |
|||
^right (* <y> 2) |
|||
^return-to <s>)} |
|||
sp {multiply*elaborate*mod |
|||
(state <s> ^name multiply |
|||
^left <x>) |
|||
--> |
|||
(<s> ^left-mod-2 (mod <x> 2))} |
|||
sp {multiply*elaborate*recursion-done-even |
|||
(state <s> ^name multiply |
|||
^left <x> |
|||
^right <y> |
|||
^multiply-done <temp> |
|||
^left-mod-2 0) |
|||
--> |
|||
(<s> ^answer <temp>)} |
|||
sp {multiply*elaborate*recursion-done-odd |
|||
(state <s> ^name multiply |
|||
^left <x> |
|||
^right <y> |
|||
^multiply-done <temp> |
|||
^left-mod-2 1) |
|||
--> |
|||
(<s> ^answer (+ <temp> <y>))} |
|||
sp {multiply*elaborate*zero |
|||
(state <s> ^name multiply |
|||
^left 0) |
|||
--> |
|||
(<s> ^answer 0)} |
|||
sp {multiply*elaborate*done |
|||
(state <s> ^name multiply |
|||
^return-to <r> |
|||
^answer <a>) |
|||
--> |
|||
(<r> ^multiply-done <a>)}</syntaxhighlight> |
|||
=={{header|Swift}}== |
|||
<syntaxhighlight lang="swift">import Darwin |
|||
func ethiopian(var #int1:Int, var #int2:Int) -> Int { |
|||
var lhs = [int1], rhs = [int2] |
|||
func isEven(#n:Int) -> Bool {return n % 2 == 0} |
|||
func double(#n:Int) -> Int {return n * 2} |
|||
func halve(#n:Int) -> Int {return n / 2} |
|||
while int1 != 1 { |
|||
lhs.append(halve(n: int1)) |
|||
rhs.append(double(n: int2)) |
|||
int1 = halve(n: int1) |
|||
int2 = double(n: int2) |
|||
} |
|||
var returnInt = 0 |
|||
for (a,b) in zip(lhs, rhs) { |
|||
if (!isEven(n: a)) { |
|||
returnInt += b |
|||
} |
|||
} |
|||
return returnInt |
|||
} |
|||
println(ethiopian(int1: 17, int2: 34))</syntaxhighlight> |
|||
{{out}} |
|||
<pre>578</pre> |
|||
=={{header|Tcl}}== |
=={{header|Tcl}}== |
||
<syntaxhighlight lang="tcl"># This is how to declare functions - the mathematical entities - as opposed to procedures |
|||
<lang tcl>proc tcl::mathfunc::double n {expr {$n * 2}} |
|||
proc function {name arguments body} { |
|||
proc tcl::mathfunc::halve n {expr {$n / 2}} |
|||
proc tcl::mathfunc:: |
uplevel 1 [list proc tcl::mathfunc::$name $arguments [list expr $body]] |
||
} |
|||
proc tcl::mathfunc::mult {a b} {expr { |
|||
function double n {$n * 2} |
|||
function halve n {$n / 2} |
|||
function even n {($n & 1) == 0} |
|||
function mult {a b} { |
|||
$a < 1 ? 0 : |
$a < 1 ? 0 : |
||
even($a) ? [logmult STRUCK] + mult(halve($a), double($b)) |
even($a) ? [logmult STRUCK] + mult(halve($a), double($b)) |
||
: [logmult KEPT] + mult(halve($a), double($b)) + $b |
: [logmult KEPT] + mult(halve($a), double($b)) + $b |
||
} |
|||
# Wrapper to set up the logging |
# Wrapper to set up the logging |
||
Line 1,372: | Line 6,405: | ||
} |
} |
||
return [expr {mult($a,$b)}] |
return [expr {mult($a,$b)}] |
||
}</syntaxhighlight>Demo code:<syntaxhighlight lang="tcl">puts "17 * 34 = [ethiopianMultiply 17 34 true]"</syntaxhighlight>{{out}} |
|||
}</lang> |
|||
Ethiopian multiplication of 17 and 34 |
|||
Demo code: |
|||
<lang tcl>puts "17 * 34 = [ethiopianMultiply 17 34 true]"</lang> |
|||
Output: |
|||
<pre>Ethiopian multiplication of 17 and 34 |
|||
17 34 KEPT |
17 34 KEPT |
||
8 68 STRUCK |
8 68 STRUCK |
||
Line 1,382: | Line 6,412: | ||
2 272 STRUCK |
2 272 STRUCK |
||
1 544 KEPT |
1 544 KEPT |
||
17 * 34 = 578 |
17 * 34 = 578 |
||
=={{header|TUSCRIPT}}== |
|||
<syntaxhighlight lang="tuscript"> |
|||
$$ MODE TUSCRIPT |
|||
ASK "insert number1", nr1="" |
|||
ASK "insert number2", nr2="" |
|||
SET nrs=APPEND(nr1,nr2),size_nrs=SIZE(nrs) |
|||
IF (size_nrs!=2) ERROR/STOP "insert two numbers" |
|||
LOOP n=nrs |
|||
IF (n!='digits') ERROR/STOP n, " is not a digit" |
|||
ENDLOOP |
|||
PRINT "ethopian multiplication of ",nr1," and ",nr2 |
|||
SET sum=0 |
|||
SECTION checkifeven |
|||
SET even=MOD(nr1,2) |
|||
IF (even==0) THEN |
|||
SET action="struck" |
|||
ELSE |
|||
SET action="kept" |
|||
SET sum=APPEND (sum,nr2) |
|||
ENDIF |
|||
SET nr1=CENTER (nr1,+6),nr2=CENTER (nr2,+6),action=CENTER (action,8) |
|||
PRINT nr1,nr2,action |
|||
ENDSECTION |
|||
SECTION halve_i |
|||
SET nr1=nr1/2 |
|||
ENDSECTION |
|||
SECTION double_i |
|||
nr2=nr2*2 |
|||
ENDSECTION |
|||
DO checkifeven |
|||
LOOP |
|||
DO halve_i |
|||
DO double_i |
|||
DO checkifeven |
|||
IF (nr1==1) EXIT |
|||
ENDLOOP |
|||
SET line=REPEAT ("=",20), sum = sum(sum),sum=CENTER (sum,+12) |
|||
PRINT line |
|||
PRINT sum |
|||
</syntaxhighlight>{{out}} |
|||
ethopian multiplication of 17 and 34 |
|||
17 34 kept |
|||
8 68 struck |
|||
4 136 struck |
|||
2 272 struck |
|||
1 544 kept |
|||
==================== |
|||
578 |
|||
== {{header|TypeScript}} == |
|||
{{trans|Modula-2}} |
|||
<syntaxhighlight lang="javascript"> |
|||
// Ethiopian multiplication |
|||
function double(a: number): number { |
|||
return 2 * a; |
|||
} |
|||
function halve(a: number): number { |
|||
return Math.floor(a / 2); |
|||
} |
|||
function isEven(a: number): bool { |
|||
return a % 2 == 0; |
|||
} |
|||
function showEthiopianMultiplication(x: number, y: number): void { |
|||
var tot = 0; |
|||
while (x >= 1) { |
|||
process.stdout.write(x.toString().padStart(9, ' ') + " "); |
|||
if (!isEven(x)) { |
|||
tot += y; |
|||
process.stdout.write(y.toString().padStart(9, ' ')); |
|||
} |
|||
console.log(); |
|||
x = halve(x); |
|||
y = double(y); |
|||
} |
|||
console.log("=" + " ".repeat(9) + tot.toString().padStart(9, ' ')); |
|||
} |
|||
showEthiopianMultiplication(17, 34); |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
17 34 |
|||
8 |
|||
4 |
|||
2 |
|||
1 544 |
|||
= 578 |
|||
</pre> |
|||
=={{header|UNIX Shell}}== |
=={{header|UNIX Shell}}== |
||
Tried with ''bash --posix'', and also with Heirloom's ''sh''. Beware that ''bash --posix'' has more features than ''sh''; this script uses only ''sh'' features. |
|||
(Tried with <tt>bash --posix</tt>, so it should run in <tt>sh</tt> too) |
|||
<lang bash>halve() |
|||
{{works with|Bourne Shell}} |
|||
<syntaxhighlight lang="bash">halve() |
|||
{ |
{ |
||
expr "$1" / 2 |
|||
} |
} |
||
double() |
double() |
||
{ |
{ |
||
expr "$1" \* 2 |
|||
} |
} |
||
is_even() |
|||
{ |
{ |
||
expr "$1" % 2 = 0 >/dev/null |
|||
} |
} |
||
Line 1,406: | Line 6,539: | ||
plicand=$2 |
plicand=$2 |
||
r=0 |
r=0 |
||
while [ $plier -ge 1 ]; do |
while [ "$plier" -ge 1 ]; do |
||
is_even "$plier" || r=`expr $r + "$plicand"` |
|||
plier=`halve "$plier"` |
|||
r=$(( r + plicand)) |
|||
plicand=`double "$plicand"` |
|||
fi |
|||
plier=$(halve $plier) |
|||
plicand=$(double $plicand) |
|||
done |
done |
||
echo $r |
echo $r |
||
} |
} |
||
ethiopicmult 17 34 |
|||
# => 578</syntaxhighlight> |
|||
While breaking if the --posix flag is passed to bash, the following alternative script avoids the *, /, and % operators. It also uses local variables and built-in arithmetic. |
|||
{{works with|bash}} |
|||
{{works with|pdksh}} |
|||
{{works with|zsh}} |
|||
<syntaxhighlight lang="bash">halve() { |
|||
(( $1 >>= 1 )) |
|||
} |
|||
double() { |
|||
(( $1 <<= 1 )) |
|||
} |
|||
is_even() { |
|||
(( ($1 & 1) == 0 )) |
|||
} |
|||
multiply() { |
|||
local plier=$1 |
|||
local plicand=$2 |
|||
local result=0 |
|||
while (( plier > 0 )) |
|||
do |
|||
is_even plier || (( result += plicand )) |
|||
halve plier |
|||
double plicand |
|||
done |
|||
echo $result |
|||
} |
|||
multiply 17 34 |
|||
# => 578</syntaxhighlight> |
|||
==={{header|C Shell}}=== |
|||
<syntaxhighlight lang="csh">alias halve '@ \!:1 /= 2' |
|||
alias double '@ \!:1 *= 2' |
|||
alias is_even '@ \!:1 = ! ( \!:2 % 2 )' |
|||
alias multiply eval \''set multiply_args=( \!*:q ) \\ |
|||
@ multiply_plier = $multiply_args[2] \\ |
|||
@ multiply_plicand = $multiply_args[3] \\ |
|||
@ multiply_result = 0 \\ |
|||
while ( $multiply_plier > 0 ) \\ |
|||
is_even multiply_is_even $multiply_plier \\ |
|||
if ( ! $multiply_is_even ) then \\ |
|||
@ multiply_result += $multiply_plicand \\ |
|||
endif \\ |
|||
halve multiply_plier \\ |
|||
double multiply_plicand \\ |
|||
end \\ |
|||
@ $multiply_args[1] = $multiply_result \\ |
|||
'\' |
|||
multiply p 17 34 |
|||
echo $p |
|||
# => 578</syntaxhighlight> |
|||
=={{header|Ursala}}== |
=={{header|Ursala}}== |
||
This solution makes use of the functions odd, double, and half, which respectively |
|||
The first implementation below relies on the representation of natural numbers as lists of bits, |
|||
check the parity, double a given natural number, or perform truncating division by two. These |
|||
lsb first, so that halving is the same as taking the tail, doubling |
|||
functions are normally imported from the nat library but defined here explicitly for |
|||
is inserting a zero, and filtering for oddness is filtering by the head, |
|||
the sake of completeness.<syntaxhighlight lang="ursala">odd = ~&ihB |
|||
all of which are expressible as primitives. |
|||
double = ~&iNiCB |
|||
<lang Ursala> |
|||
half = ~&itB</syntaxhighlight>The functions above are defined in terms of bit manipulations exploiting the concrete representations of natural numbers. The remaining code treats natural numbers instead as abstract types by way of the library API, and uses the operators for distribution (*-), triangular iteration (|\), |
|||
#import nat |
|||
and filtering (*~) among others.<syntaxhighlight lang="ursala">#import nat |
|||
emul = sum:-0@rS+ odd@l*~+ ^|(~&,double)|\+ *-^|\~& @iNC ~&h~=0->tx :^/half@h ~&</syntaxhighlight>test program:<syntaxhighlight lang="ursala">#cast %n |
|||
emul = @lrtK33PDNlCrXK9rhPFlS sum:-0 |
|||
</lang> |
|||
Here is a more verbose version (in keeping with the spirit of the task) treating natural numbers |
|||
as abstract types, and explicitly using the operators for distribution (*-), triangular iteration (|\), |
|||
and filtering (*~) among others. |
|||
<lang Ursala> |
|||
#import nat |
|||
test = emul(34,17)</syntaxhighlight>{{out}} |
|||
emul = sum:-0@rS+ odd@l*~+ ^|(~&,double)|\+ *-^|\~& @iNC ~&h~=0->tx :^/half@h ~& |
|||
578 |
|||
</lang> |
|||
=={{header|VBA}}== |
|||
test program: |
|||
Define three named functions : |
|||
<lang Ursala> |
|||
# one to '''halve an integer''', |
|||
#cast %n |
|||
# one to '''double an integer''', and |
|||
# one to '''state if an integer is even'''. |
|||
<syntaxhighlight lang="vb">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</syntaxhighlight> |
|||
Use these functions to create a function that does Ethiopian multiplication. |
|||
The first function below is a non optimized function : |
|||
<syntaxhighlight lang="vb">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</syntaxhighlight> |
|||
This one is better : |
|||
<syntaxhighlight lang="vb">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 |
|||
Ethiopian_Multiplication = Mult_Eth |
|||
End Function</syntaxhighlight> |
|||
Then you can call one of these functions like this : |
|||
<syntaxhighlight lang="vb">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</syntaxhighlight> |
|||
=={{header|VBScript}}== |
|||
Nowhere near as optimal a solution as the Ada. Yes, it could have made as optimal, but the long way seemed more interesting. |
|||
Demonstrates a List class. The .recall and .replace methods have bounds checking but the code does not test for the exception that would be raised. List class extends the storage allocated for the list when the occupation of the list goes beyond the original allocation. |
|||
<code>option explicit</code> makes sure that all variables are declared. |
|||
'''Implementation'''<syntaxhighlight lang="vb">option explicit |
|||
class List |
|||
private theList |
|||
private nOccupiable |
|||
private nTop |
|||
sub class_initialize |
|||
nTop = 0 |
|||
nOccupiable = 100 |
|||
redim theList( nOccupiable ) |
|||
end sub |
|||
public sub store( x ) |
|||
if nTop >= nOccupiable then |
|||
nOccupiable = nOccupiable + 100 |
|||
redim preserve theList( nOccupiable ) |
|||
end if |
|||
theList( nTop ) = x |
|||
nTop = nTop + 1 |
|||
end sub |
|||
public function recall( n ) |
|||
if n >= 0 and n <= nOccupiable then |
|||
recall = theList( n ) |
|||
else |
|||
err.raise vbObjectError + 1000,,"Recall bounds error" |
|||
end if |
|||
end function |
|||
public sub replace( n, x ) |
|||
if n >= 0 and n <= nOccupiable then |
|||
theList( n ) = x |
|||
else |
|||
err.raise vbObjectError + 1001,,"Replace bounds error" |
|||
end if |
|||
end sub |
|||
public property get listCount |
|||
listCount = nTop |
|||
end property |
|||
end class |
|||
function halve( n ) |
|||
halve = int( n / 2 ) |
|||
end function |
|||
function twice( n ) |
|||
twice = int( n * 2 ) |
|||
end function |
|||
function iseven( n ) |
|||
iseven = ( ( n mod 2 ) = 0 ) |
|||
end function |
|||
function multiply( n1, n2 ) |
|||
dim LL |
|||
set LL = new List |
|||
dim RR |
|||
set RR = new List |
|||
LL.store n1 |
|||
RR.store n2 |
|||
do while n1 <> 1 |
|||
n1 = halve( n1 ) |
|||
LL.store n1 |
|||
n2 = twice( n2 ) |
|||
RR.store n2 |
|||
loop |
|||
dim i |
|||
for i = 0 to LL.listCount |
|||
if iseven( LL.recall( i ) ) then |
|||
RR.replace i, 0 |
|||
end if |
|||
next |
|||
dim total |
|||
total = 0 |
|||
for i = 0 to RR.listCount |
|||
total = total + RR.recall( i ) |
|||
next |
|||
multiply = total |
|||
end function |
|||
</syntaxhighlight>'''Invocation'''<syntaxhighlight lang="vb"> |
|||
wscript.echo multiply(17,34) |
|||
</syntaxhighlight>{{out}} |
|||
578 |
|||
=={{header|V (Vlang)}}== |
|||
{{trans|go}} |
|||
<syntaxhighlight lang="v (vlang)">fn halve(i int) int { return i/2 } |
|||
fn double(i int) int { return i*2 } |
|||
fn is_even(i int) bool { return i%2 == 0 } |
|||
fn eth_multi(ii int, jj int) int { |
|||
mut r := 0 |
|||
mut i, mut j := ii, jj |
|||
for ; i > 0; i, j = halve(i), double(j) { |
|||
if !is_even(i) { |
|||
r += j |
|||
} |
|||
} |
|||
return r |
|||
} |
|||
fn main() { |
|||
println("17 ethiopian 34 = ${eth_multi(17, 34)}") |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>17 ethiopian 34 = 578</pre> |
|||
=={{header|Wren}}== |
|||
<syntaxhighlight lang="wren">var halve = Fn.new { |n| (n/2).truncate } |
|||
var double = Fn.new { |n| n * 2 } |
|||
var isEven = Fn.new { |n| n%2 == 0 } |
|||
var ethiopian = Fn.new { |x, y| |
|||
var sum = 0 |
|||
while (x >= 1) { |
|||
if (!isEven.call(x)) sum = sum + y |
|||
x = halve.call(x) |
|||
y = double.call(y) |
|||
} |
|||
return sum |
|||
} |
|||
System.print("17 x 34 = %(ethiopian.call(17, 34))") |
|||
System.print("99 x 99 = %(ethiopian.call(99, 99))")</syntaxhighlight> |
|||
{{out}} |
|||
test = emul(34,17) |
|||
</lang> |
|||
output: |
|||
<pre> |
<pre> |
||
578 |
17 x 34 = 578 |
||
99 x 99 = 9801 |
|||
</pre> |
</pre> |
||
=={{header|x86 |
=={{header|x86 Assembly}}== |
||
{{works with|nasm}}, linking with the C standard library and start code. |
{{works with|nasm}}, linking with the C standard library and start code. |
||
<syntaxhighlight lang="asm"> extern printf |
|||
<lang asm> |
|||
extern printf |
|||
global main |
global main |
||
Line 1,559: | Line 6,951: | ||
db "struck", 0 |
db "struck", 0 |
||
kepttxt |
kepttxt |
||
db "kept", 0</ |
db "kept", 0</syntaxhighlight> |
||
===Smaller version=== |
===Smaller version=== |
||
Using old style 16 bit registers created in debug |
Using old style 16 bit registers created in debug |
||
Line 1,575: | Line 6,964: | ||
to test if the value is even |
to test if the value is even |
||
< |
<syntaxhighlight lang="asm">test,01 |
||
jz Even |
jz Even |
||
Odd: |
Odd: |
||
Even:</syntaxhighlight><syntaxhighlight lang="asm">;calling program |
|||
Even:</lang> |
|||
<lang asm>;calling program |
|||
1BDC:0100 6A11 PUSH 11 ;17 Put operands on the stack |
1BDC:0100 6A11 PUSH 11 ;17 Put operands on the stack |
||
Line 1,597: | Line 6,982: | ||
1BDC:010E 90 NOP |
1BDC:010E 90 NOP |
||
1BDC:010F 90 NOP |
1BDC:010F 90 NOP |
||
;mulitplication routine |
;mulitplication routine starts here |
||
1BDC:0110 89E5 MOV BP,SP ; prepare to get operands off stack |
1BDC:0110 89E5 MOV BP,SP ; prepare to get operands off stack |
||
1BDC:0112 8B4E02 MOV CX,[BP+02] ; Get the first operand |
1BDC:0112 8B4E02 MOV CX,[BP+02] ; Get the first operand |
||
Line 1,605: | Line 6,990: | ||
1BDC:011E 7402 JZ 0122 ; no skip the next instruction |
1BDC:011E 7402 JZ 0122 ; no skip the next instruction |
||
1BDC:0120 01D8 ADD AX,BX ; we are odd so add to the result |
1BDC:0120 01D8 ADD AX,BX ; we are odd so add to the result |
||
1BDC:0122 |
1BDC:0122 D1E3 SHL BX,1 ; multiply by 2 |
||
1BDC:0124 |
1BDC:0124 D1E9 SHR CX,1 ; divide by 2 (if zr flag is set, we are done) |
||
1BDC:0126 |
1BDC:0126 75F2 JNZ 011A ; cx not 0, go back and do it again |
||
1BDC: |
1BDC:0128 C3 RET ; return with the result in AX |
||
1BDC:012B 01D8 ADD AX,BX ; final add |
|||
;pretty small, just 24 bytes </syntaxhighlight> |
|||
1BDC:012D C3 RET ; return with the result in AX |
|||
=={{header|XPL0}}== |
|||
<syntaxhighlight lang="xpl0">include c:\cxpl\codes; \intrinsic 'code' declarations |
|||
func Halve(N); \Return half of N |
|||
int N; |
|||
return N>>1; |
|||
func Double(N); \Return N doubled |
|||
int N; |
|||
return N<<1; |
|||
func IsEven(N); \Return 'true' if N is an even number |
|||
int N; |
|||
return (N&1)=0; |
|||
func EthiopianMul(A, B); \Multiply A times B using Ethiopian method |
|||
int A, B; |
|||
int I, J, S, Left(100), Right(100); |
|||
[Left(0):= A; Right(0):= B; \1. write numbers to be multiplied |
|||
I:= 1; \2. repeatedly halve number on left |
|||
repeat A:= Halve(A); |
|||
Left(I):= A; I:= I+1; |
|||
until A=1; |
|||
J:= 1; \3. repeatedly double number on right |
|||
repeat B:= Double(B); |
|||
Right(J):= B; J:= J+1; |
|||
until J=I; \stop where left column = 1 |
|||
for J:= 0 to I-1 do \4. discard right value if left is even |
|||
if IsEven(Left(J)) then Right(J):= 0; |
|||
S:= 0; \5. sum remaining values on right |
|||
for J:= 0 to I-1 do |
|||
S:= S + Right(J); |
|||
for J:= 0 to I-1 do \show this insanity |
|||
[IntOut(0, Left(J)); ChOut(0, 9\tab\); IntOut(0, Right(J)); CrLf(0)]; |
|||
Text(0, " -------- |
|||
"); |
|||
return S; \sum = product |
|||
]; |
|||
int Product; |
|||
[Product:= EthiopianMul(17, 34); |
|||
ChOut(0, 9); IntOut(0, Product); CrLf(0); CrLf(0); |
|||
Product:= EthiopianMul(1234, 5678); |
|||
ChOut(0, 9); IntOut(0, Product); CrLf(0); |
|||
]</syntaxhighlight>{{out}} |
|||
<pre>17 34 |
|||
8 0 |
|||
4 0 |
|||
2 0 |
|||
1 544 |
|||
-------- |
|||
578 |
|||
1234 0 |
|||
617 11356 |
|||
308 0 |
|||
154 0 |
|||
77 90848 |
|||
38 0 |
|||
19 363392 |
|||
9 726784 |
|||
4 0 |
|||
2 0 |
|||
1 5814272 |
|||
-------- |
|||
7006652</pre> |
|||
=={{header|zig}}== |
|||
<syntaxhighlight lang="zig"> |
|||
// programme multiplication ethiopienne |
|||
// Ethiopian multiplication |
|||
const std = @import("std"); |
|||
const expect = std.testing.expect; |
|||
const print = @import("std").debug.print; |
|||
pub fn main() !void { |
|||
const Res = multiEth(17,34); |
|||
print("Resultat= {} \n", .{ Res }); |
|||
} |
|||
test "Ethiopian multiplication" { |
|||
try expect(multiEth(20, 10) == 200); |
|||
try expect(multiEth(101, 101) == 10201); |
|||
try expect(multiEth(20, 0) == 0); |
|||
try expect(multiEth(0, 71) == 0); |
|||
} |
|||
//***************************** |
|||
// multiplication |
|||
//***************************** |
|||
fn multiEth(X: i64, Y: i64) i64 { |
|||
var X1=X; |
|||
var Y1=Y; |
|||
var sum: i64 = 0; |
|||
while (X1>=1) { |
|||
if ((@mod(X1,2)) == 1) |
|||
sum += Y1; |
|||
Y1= Y1 * 2; |
|||
X1 = @divFloor(X1,2); |
|||
} |
|||
return sum; |
|||
} |
|||
</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
Resultat= 578 |
|||
</pre> |
|||
=={{header|zkl}}== |
|||
Trying to duplicate the task as stated, using columns. |
|||
isEven is a integer method. |
|||
<syntaxhighlight lang="zkl">fcn ethiopianMultiply(l,r){ // l is a non-negative integer |
|||
halve :=fcn(n){ n/2 }; |
|||
double :=fcn(n){ n+n }; |
|||
lr:=List(T(l,r)); // ( (l,r) .. (1,r*n) ) |
|||
while(l>1){ lr.write( T(l=halve(l),r=double(r)) ) } |
|||
lr.filter(fcn([(l,r)]){ (not l.isEven) }); // strike out even left rows |
|||
.reduce(fcn(sum,[(l,r)]){ sum + r },0); // sum right column |
|||
}</syntaxhighlight> |
|||
<syntaxhighlight lang="zkl">foreach l,r in ( T(T(17,34),T(34,1),T(34,2),T(34,0)) ){ |
|||
println(ethiopianMultiply(l,r)," ",ethiopianMultiply(r,l)); |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
578 578 |
|||
34 34 |
|||
68 68 |
|||
0 0 |
|||
</pre> |
|||
=={{header|Z80 Assembly}}== |
|||
<syntaxhighlight lang="z80"> org &8000 |
|||
ld hl,17 |
|||
call Halve_Until_1 |
|||
push bc |
|||
ld hl,34 |
|||
call Double_Until_1 |
|||
pop bc |
|||
call SumOddEntries |
|||
;returns Ethiopian product in IX. |
|||
call NewLine |
|||
call Primm |
|||
byte "0x",0 |
|||
push ix |
|||
pop hl |
|||
ld a,H |
|||
call ShowHex |
|||
;Output should be in decimal but hex is easier. |
|||
ld a,L |
|||
call ShowHex |
|||
ret |
|||
Halve_Until_1: |
|||
;input: HL = number you wish to halve. HL is unsigned. |
|||
ld de,Column_1 |
|||
ld a,1 |
|||
ld (Column_1),HL |
|||
inc de |
|||
inc de |
|||
loop_HalveUntil_1: |
|||
SRL H |
|||
RR L |
|||
inc b |
|||
push af |
|||
ld a,L |
|||
ld (de),a |
|||
inc de |
|||
ld a,H |
|||
ld (de),a |
|||
inc de |
|||
pop af |
|||
CP L |
|||
jr nz,loop_HalveUntil_1 |
|||
;b tracks how many times to double the second factor. |
|||
ret |
|||
Double_Until_1: |
|||
;doubles second factor B times. B is calculated by Halve_until_1 |
|||
ld de,Column_2 |
|||
ld (Column_2),HL |
|||
inc de |
|||
inc de |
|||
loop_double_until_1: |
|||
SLA L |
|||
RL H |
|||
PUSH AF |
|||
LD A,L |
|||
LD (DE),A |
|||
INC DE |
|||
LD A,H |
|||
LD (DE),A |
|||
INC DE |
|||
POP AF |
|||
DJNZ loop_double_until_1 |
|||
ret |
|||
SumOddEntries: |
|||
sla b ;double loop counter, this is also the offset to the "last" entry of |
|||
;each table |
|||
ld h,>Column_1 |
|||
ld d,>Column_2 ;aligning the tables lets us get away with this. |
|||
ld l,b |
|||
ld e,b |
|||
ld ix,0 |
|||
loop: |
|||
ld a,(hl) |
|||
rrca ;we only need the result of the odd/even test. |
|||
jr nc,skipEven |
|||
push hl |
|||
push de |
|||
ld a,(de) |
|||
ld L,a |
|||
inc de |
|||
ld a,(de) |
|||
ld H,a |
|||
ex de,hl |
|||
add ix,de |
|||
pop de |
|||
pop hl |
|||
skipEven: |
|||
dec de |
|||
dec de |
|||
dec hl |
|||
dec hl |
|||
djnz loop |
|||
ret ;ix should contain the answer |
|||
align 8 ;aligns Column_1 to the nearest 256 byte boundary. This makes offsetting easier. |
|||
Column_1: |
|||
ds 16,0 |
|||
align 8 ;aligns Column_2 to the nearest 256 byte boundary. This makes offsetting easier. |
|||
Column_2: |
|||
ds 16,0</syntaxhighlight> |
|||
{{out}} |
|||
Output is in hex but is otherwise correct. |
|||
<pre> |
|||
0x0242 |
|||
</pre> |
|||
=={{header|ZX Spectrum Basic}}== |
|||
{{trans|GW-BASIC}} |
|||
<syntaxhighlight lang="zxbasic">10 DEF FN e(a)=a-INT (a/2)*2-1 |
|||
20 DEF FN h(a)=INT (a/2) |
|||
30 DEF FN d(a)=2*a |
|||
40 LET x=17: LET y=34: LET tot=0 |
|||
50 IF x<1 THEN GO TO 100 |
|||
60 PRINT x;TAB (4); |
|||
70 IF FN e(x)=0 THEN LET tot=tot+y: PRINT y: GO TO 90 |
|||
80 PRINT "---" |
|||
90 LET x=FN h(x): LET y=FN d(y): GO TO 50 |
|||
100 PRINT TAB (4);"===",TAB (4);tot</syntaxhighlight> |
|||
[[Category:Arithmetic]] |
|||
;pretty small |
|||
</lang> |
Latest revision as of 14:43, 5 August 2024
![Task](http://static.miraheze.org/rosettacodewiki/thumb/b/ba/Rcode-button-task-crushed.png/64px-Rcode-button-task-crushed.png)
You are encouraged to solve this task according to the task description, using any language you may know.
Ethiopian multiplication is a method of multiplying integers using only addition, doubling, and halving.
Method:
- Take two numbers to be multiplied and write them down at the top of two columns.
- 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.
- 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.
- Examine the table produced and discard any row where the value in the left column is even.
- Sum the values in the right-hand column that remain to produce the result of multiplying the original two numbers together
For example: 17 × 34
17 34
Halving the first column:
17 34 8 4 2 1
Doubling the second column:
17 34 8 68 4 136 2 272 1 544
Strike-out rows whose first cell is even:
17 34 868413622721 544
Sum the remaining numbers in the right-hand column:
17 34 8 -- 4 --- 2 --- 1 544 ==== 578
So 17 multiplied by 34, by the Ethiopian method is 578.
- Task
The task is to define three named functions/methods/procedures/subroutines:
- one to halve an integer,
- one to double an integer, and
- one to state if an integer is even.
Use these functions to create a function that does Ethiopian multiplication.
- Related tasks
- References
- Ethiopian multiplication explained (BBC Video clip)
- A Night Of Numbers - Go Forth And Multiply (Video)
- Russian Peasant Multiplication
- Programming Praxis: Russian Peasant Multiplication
11l
F halve(x)
R x I/ 2
F double(x)
R x * 2
F even(x)
R !(x % 2)
F ethiopian(=multiplier, =multiplicand)
V result = 0
L multiplier >= 1
I !even(multiplier)
result += multiplicand
multiplier = halve(multiplier)
multiplicand = double(multiplicand)
R result
print(ethiopian(17, 34))
- Output:
578
8080 Assembly
The 8080 does not have a hardware multiplier, but it does have addition and rotation, so this code is actually useful. Indeed, it is pretty much the standard algorithm for general multiplication on processors that do not have a hardware multiplier.
You would not normally name the sections (halve, double, even), since they rely on each other and cannot be called independently. Pulling them out entirely would entail a performance hit and make the whole thing much less elegant, so I've done it this way as a sort of compromise.
org 100h
jmp demo
;;; HL = BC * DE
;;; BC is left column, DE is right column
emul: lxi h,0 ; HL will be the accumulator
ztest: mov a,b ; Check if the left column is zero.
ora c ; If so, stop.
rz
halve: mov a,b ; Halve BC by rotating it right.
rar ; We know the carry is zero here because of the ORA.
mov b,a ; So rotate the top half first,
mov a,c ; Then the bottom half
rar ; This leaves the old low bit in the carry flag,
mov c,a ; so this also lets us do the even/odd test in one go.
even: jnc $+4 ; If no carry, the number is even, so skip (strikethrough)
dad d ; But if odd, add the number in the right column
double: xchg ; Doubling DE is a bit easier since you can add
dad h ; HL to itself in one go, and XCHG swaps DE and HL
xchg
jmp ztest ; We want to do the whole thing again until BC is zero
;;; Demo code, print 17 * 34
demo: lxi b,17 ; Load 17 into BC (left column)
lxi d,34 ; Load 34 into DE (right column)
call emul ; Do the multiplication
print: lxi b,-10 ; Decimal output routine (not very interesting here,
lxi d,pbuf ; but without it you can't see the result)
push d
digit: lxi d,-1
dloop: inx d
dad b
jc dloop
mvi a,58
add l
pop h
dcx h
mov m,a
push h
xchg
mov a,h
ora l
jnz digit
pop d
mvi c,9
jmp 5
db '*****'
pbuf: db '$'
- Output:
578
AArch64 Assembly
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program multieth64.s */
/************************************/
/* Constantes */
/************************************/
.include "../includeConstantesARM64.inc"
/*********************************/
/* Initialized data */
/*********************************/
.data
szMessResult: .asciz "Result : "
szMessStart: .asciz "Program 64 bits start.\n"
szCarriageReturn: .asciz "\n"
szMessErreur: .asciz "Error overflow. \n"
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: // entry of program
ldr x0,qAdrszMessStart
bl affichageMess
mov x0,#17
mov x1,#34
bl multEthiop
ldr x1,qAdrsZoneConv
bl conversion10 // decimal conversion
mov x0,#3 // number string to display
ldr x1,qAdrszMessResult
ldr x2,qAdrsZoneConv // insert conversion in message
ldr x3,qAdrszCarriageReturn
bl displayStrings // display message
100: // standard end of the program
mov x0, #0 // return code
mov x8,EXIT
svc #0 // perform the system call
qAdrszCarriageReturn: .quad szCarriageReturn
qAdrsZoneConv: .quad sZoneConv
qAdrszMessResult: .quad szMessResult
qAdrszMessErreur: .quad szMessErreur
qAdrszMessStart: .quad szMessStart
/******************************************************************/
/* Ethiopian multiplication unsigned */
/******************************************************************/
/* x0 first factor */
/* x1 2th factor */
/* x0 return résult */
multEthiop:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
mov x2,#0 // init result
1: // loop
cmp x0,#1 // end ?
blt 3f
ands x3,x0,#1 //
add x3,x2,x1 // add factor2 to result
csel x2,x2,x3,eq
mov x3,1
lsr x0,x0,x3 // divide factor1 by 2
cmp x1,0 // overflow ? if bit 63 = 1 ie negative number
blt 2f
mov x4,1
lsl x1,x1,x4 // multiply factor2 by 2
b 1b // or loop
2: // error display
ldr x0,qAdrszMessErreur
bl affichageMess
mov x2,#0
3:
mov x0,x2 // return result
ldp x2,x3,[sp],16 // restaur registers
ldp x1,lr,[sp],16 // restaur registers
ret
/***************************************************/
/* display multi strings */
/***************************************************/
/* x0 contains number strings address */
/* x1 address string1 */
/* x2 address string2 */
/* x3 address string3 */
/* other address on the stack */
/* thinck to add number other address * 8 to add to the stack */
displayStrings: // INFO: displayStrings
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
stp x4,x5,[sp,-16]! // save registers
add fp,sp,#48 // save paraméters address (6 registers saved * 4 bytes)
mov x4,x0 // save strings number
cmp x4,#0 // 0 string -> end
ble 100f
mov x0,x1 // string 1
bl affichageMess
cmp x4,#1 // number > 1
ble 100f
mov x0,x2
bl affichageMess
cmp x4,#2
ble 100f
mov x0,x3
bl affichageMess
cmp x4,#3
ble 100f
mov x3,#3
sub x2,x4,#8
1: // loop extract address string on stack
ldr x0,[fp,x2,lsl #3]
bl affichageMess
subs x2,x2,#1
bge 1b
100:
ldp x4,x5,[sp],16 // restaur registers
ldp x2,x3,[sp],16 // restaur registers
ldp x1,lr,[sp],16 // restaur registers
ret
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
.include "../includeARM64.inc"
- Output:
Program 64 bits start. Result : 578
ACL2
(include-book "arithmetic-3/top" :dir :system)
(defun halve (x)
(floor x 2))
(defun double (x)
(* x 2))
(defun is-even (x)
(evenp x))
(defun multiply (x y)
(if (zp (1- x))
y
(+ (if (is-even x)
0
y)
(multiply (halve x) (double y)))))
Action!
INT FUNC EthopianMult(INT a,b)
INT res
PrintF("Ethopian multiplication %I by %I:%E",a,b)
res=0
WHILE a>=1
DO
IF a MOD 2=0 THEN
PrintF("%I %I strike%E",a,b)
ELSE
PrintF("%I %I keep%E",a,b)
res==+b
FI
a==/2
b==*2
OD
RETURN (res)
PROC Main()
INT res
res=EthopianMult(17,34)
PrintF("Result is %I",res)
RETURN
- Output:
Screenshot from Atari 8-bit computer
Ethopian multiplication 17 by 34: 17 34 keep 8 68 strike 4 136 strike 2 272 strike 1 544 keep Result is 578
ActionScript
function Divide(a:Number):Number {
return ((a-(a%2))/2);
}
function Multiply(a:Number):Number {
return (a *= 2);
}
function isEven(a:Number):Boolean {
if (a%2 == 0) {
return (true);
} else {
return (false);
}
}
function Ethiopian(left:Number, right:Number) {
var r:Number = 0;
trace(left+" "+right);
while (left != 1) {
var State:String = "Keep";
if (isEven(Divide(left))) {
State = "Strike";
}
trace(Divide(left)+" "+Multiply(right)+" "+State);
left = Divide(left);
right = Multiply(right);
if (State == "Keep") {
r += right;
}
}
trace("="+" "+r);
}
}
- Output:
ex. Ethiopian(17,34);
17 34 8 68 Strike 4 136 Strike 2 272 Strike 1 544 Keep
Ada
with ada.text_io;use ada.text_io;
procedure ethiopian is
function double (n : Natural) return Natural is (2*n);
function halve (n : Natural) return Natural is (n/2);
function is_even (n : Natural) return Boolean is (n mod 2 = 0);
function mul (l, r : Natural) return Natural is
(if l = 0 then 0 elsif l = 1 then r elsif is_even (l) then mul (halve (l),double (r))
else r + double (mul (halve (l), r)));
begin
put_line (mul (17,34)'img);
end ethiopian;
Aime
void
halve(integer &x)
{
x >>= 1;
}
void
double(integer &x)
{
x <<= 1;
}
integer
iseven(integer x)
{
return (x & 1) == 0;
}
integer
ethiopian(integer plier, integer plicand, integer tutor)
{
integer result;
result = 0;
if (tutor) {
o_form("ethiopian multiplication of ~ by ~\n", plier, plicand);
}
while (plier >= 1) {
if (iseven(plier)) {
if (tutor) {
o_form("/w4/ /w6/ struck\n", plier, plicand);
}
} else {
if (tutor) {
o_form("/w4/ /w6/ kept\n", plier, plicand);
}
result += plicand;
}
halve(plier);
double(plicand);
}
return result;
}
integer
main(void)
{
o_integer(ethiopian(17, 34, 1));
o_byte('\n');
return 0;
}
17 34 kept 8 68 struck 4 136 struck 2 272 struck 1 544 kept 578
ALGOL 68
PROC halve = (REF INT x)VOID: x := ABS(BIN x SHR 1);
PROC doublit = (REF INT x)VOID: x := ABS(BIN x SHL 1);
PROC iseven = (#CONST# INT x)BOOL: NOT ODD x;
PROC ethiopian = (INT in plier,
INT in plicand, #CONST# BOOL tutor)INT:
(
INT plier := in plier, plicand := in plicand;
INT result:=0;
IF tutor THEN
printf(($"ethiopian multiplication of "g(0)," by "g(0)l$, plier, plicand)) FI;
WHILE plier >= 1 DO
IF iseven(plier) THEN
IF tutor THEN printf(($" "4d," "6d" struck"l$, plier, plicand)) FI
ELSE
IF tutor THEN printf(($" "4d," "6d" kept"l$, plier, plicand)) FI;
result +:= plicand
FI;
halve(plier); doublit(plicand)
OD;
result
);
main:
(
printf(($g(0)l$, ethiopian(17, 34, TRUE)))
)
- Output:
ethiopian multiplication of 17 by 34 0017 000034 kept 0008 000068 struck 0004 000136 struck 0002 000272 struck 0001 000544 kept 578
ALGOL-M
BEGIN
INTEGER FUNCTION HALF(I);
INTEGER I;
BEGIN
HALF := I / 2;
END;
INTEGER FUNCTION DOUBLE(I);
INTEGER I;
BEGIN
DOUBLE := I + I;
END;
% RETURN 1 IF EVEN, OTHERWISE 0 %
INTEGER FUNCTION EVEN(I);
INTEGER I;
BEGIN
EVEN := 1 - (I - 2 * (I / 2));
END;
% RETURN I * J AND OPTIONALLY SHOW COMPUTATIONAL STEPS %
INTEGER FUNCTION ETHIOPIAN(I, J, SHOW);
INTEGER I, J, SHOW;
BEGIN
INTEGER P, YES;
YES := 1;
P := 0;
WHILE I >= 1 DO
BEGIN
IF EVEN(I) = YES THEN
BEGIN
IF SHOW = YES THEN WRITE(I," ----", J);
END
ELSE
BEGIN
IF SHOW = YES THEN WRITE(I,J);
P := P + J;
END;
I := HALF(I);
J := DOUBLE(J);
END;
IF SHOW = YES THEN WRITE(" =");
ETHIOPIAN := P;
END;
% EXERCISE THE FUNCTION %
INTEGER YES;
YES := 1;
WRITE(ETHIOPIAN(17,34,YES));
END
- Output:
17 34 8 ---- 68 4 ---- 136 2 ---- 272 1 544 = 578
ALGOL W
begin
% returns half of a %
integer procedure halve ( integer value a ) ; a div 2;
% returns a doubled %
integer procedure double ( integer value a ) ; a * 2;
% returns true if a is even, false otherwise %
logical procedure even ( integer value a ) ; not odd( a );
% returns the product of a and b using ethopian multiplication %
% rather than keep a table of the intermediate results, %
% we examine then as they are generated %
integer procedure ethopianMultiplication ( integer value a, b ) ;
begin
integer v, r, accumulator;
v := a;
r := b;
accumulator := 0;
i_w := 4; s_w := 0; % set output formatting %
while begin
write( v );
if even( v ) then writeon( " ---" )
else begin
accumulator := accumulator + r;
writeon( " ", r );
end;
v := halve( v );
r := double( r );
v > 0
end do begin end;
write( " =====" );
accumulator
end ethopianMultiplication ;
% task test case %
begin
integer m;
m := ethopianMultiplication( 17, 34 );
write( " ", m )
end
end.
- Output:
17 34 8 --- 4 --- 2 --- 1 544 ===== 578
AppleScript
Note that this algorithm, already described in the Rhind Papyrus (c. BCE 1650), can be used to multiply strings as well as integers, if we change the identity element from 0 to the empty string, and replace integer addition with string concatenation.
See also: Repeat_a_string#AppleScript
on run
{ethMult(17, 34), ethMult("Rhind", 9)}
--> {578, "RhindRhindRhindRhindRhindRhindRhindRhind"}
end run
-- Int -> Int -> Int
-- or
-- Int -> String -> String
on ethMult(m, n)
script fns
property identity : missing value
property plus : missing value
on half(n) -- 1. half an integer (div 2)
n div 2
end half
on double(n) -- 2. double (add to self)
plus(n, n)
end double
on isEven(n) -- 3. is n even ? (mod 2 > 0)
(n mod 2) > 0
end isEven
on chooseFns(c)
if c is string then
set identity of fns to ""
set plus of fns to plusString of fns
else
set identity of fns to 0
set plus of fns to plusInteger of fns
end if
end chooseFns
on plusInteger(a, b)
a + b
end plusInteger
on plusString(a, b)
a & b
end plusString
end script
chooseFns(class of m) of fns
-- MAIN PROCESS OF CALCULATION
set o to identity of fns
if n < 1 then return o
repeat while (n > 1)
if isEven(n) of fns then -- 3. is n even ? (mod 2 > 0)
set o to plus(o, m) of fns
end if
set n to half(n) of fns -- 1. half an integer (div 2)
set m to double(m) of fns -- 2. double (add to self)
end repeat
return plus(o, m) of fns
end ethMult
- Output:
{578, "RhindRhindRhindRhindRhindRhindRhindRhindRhind"}
ARM Assembly
/* ARM assembly Raspberry PI */
/* program multieth.s */
/* REMARK 1 : this program use routines in a include file
see task Include a file language arm assembly
for the routine affichageMess conversion10
see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes */
/************************************/
.include "../constantes.inc"
/*********************************/
/* Initialized data */
/*********************************/
.data
szMessResult: .asciz "Result : "
szMessStart: .asciz "Program 32 bits start.\n"
szCarriageReturn: .asciz "\n"
szMessErreur: .asciz "Error overflow. \n"
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ entry of program
ldr r0,iAdrszMessStart
bl affichageMess
mov r0,#17
mov r1,#34
bl multEthiop
ldr r1,iAdrsZoneConv
bl conversion10 @ decimal conversion
mov r0,#3 @ number string to display
ldr r1,iAdrszMessResult
ldr r2,iAdrsZoneConv @ insert conversion in message
ldr r3,iAdrszCarriageReturn
bl displayStrings @ display message
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdrszCarriageReturn: .int szCarriageReturn
iAdrsZoneConv: .int sZoneConv
iAdrszMessResult: .int szMessResult
iAdrszMessErreur: .int szMessErreur
iAdrszMessStart: .int szMessStart
/******************************************************************/
/* Ethiopian multiplication */
/******************************************************************/
/* r0 first factor */
/* r1 2th factor */
/* r0 return résult */
multEthiop:
push {r1-r3,lr} @ save registers
mov r2,#0 @ init result
1: @ loop
cmp r0,#1 @ end ?
blt 3f
ands r3,r0,#1 @
addne r2,r1 @ add factor2 to result
lsr r0,#1 @ divide factor1 by 2
lsls r1,#1 @ multiply factor2 by 2
bcs 2f @ overflow ?
b 1b @ or loop
2: @ error display
ldr r0,iAdrszMessErreur
bl affichageMess
mov r2,#0
3:
mov r0,r2 @ return result
pop {r1-r3,pc}
/***************************************************/
/* display multi strings */
/***************************************************/
/* r0 contains number strings address */
/* r1 address string1 */
/* r2 address string2 */
/* r3 address string3 */
/* other address on the stack */
/* thinck to add number other address * 4 to add to the stack */
displayStrings: @ INFO: displayStrings
push {r1-r4,fp,lr} @ save des registres
add fp,sp,#24 @ save paraméters address (6 registers saved * 4 bytes)
mov r4,r0 @ save strings number
cmp r4,#0 @ 0 string -> end
ble 100f
mov r0,r1 @ string 1
bl affichageMess
cmp r4,#1 @ number > 1
ble 100f
mov r0,r2
bl affichageMess
cmp r4,#2
ble 100f
mov r0,r3
bl affichageMess
cmp r4,#3
ble 100f
mov r3,#3
sub r2,r4,#4
1: @ loop extract address string on stack
ldr r0,[fp,r2,lsl #2]
bl affichageMess
subs r2,#1
bge 1b
100:
pop {r1-r4,fp,pc}
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
.include "../affichage.inc"
- Output:
Program 32 bits start. Result : 578
Arturo
halve: function [x]-> shr x 1
double: function [x]-> shl x 1
; even? already exists
ethiopian: function [x y][
prod: 0
while [x > 0][
unless even? x [prod: prod + y]
x: halve x
y: double y
]
return prod
]
print ethiopian 17 34
print ethiopian 2 3
- Output:
578 6
AutoHotkey
MsgBox % Ethiopian(17, 34) "`n" Ethiopian2(17, 34)
; func definitions:
half( x ) {
return x >> 1
}
double( x ) {
return x << 1
}
isEven( x ) {
return x & 1 == 0
}
Ethiopian( a, b ) {
r := 0
While (a >= 1) {
if !isEven(a)
r += b
a := half(a)
b := double(b)
}
return r
}
; or a recursive function:
Ethiopian2( a, b, r = 0 ) { ;omit r param on initial call
return a==1 ? r+b : Ethiopian2( half(a), double(b), !isEven(a) ? r+b : r )
}
AutoIt
Func Halve($x)
Return Int($x/2)
EndFunc
Func Double($x)
Return ($x*2)
EndFunc
Func IsEven($x)
Return (Mod($x,2) == 0)
EndFunc
; this version also supports negative parameters
Func Ethiopian($nPlier, $nPlicand, $bTutor = True)
Local $nResult = 0
If ($nPlier < 0) Then
$nPlier =- $nPlier
$nPlicand =- $nPlicand
ElseIf ($nPlicand > 0) And ($nPlier > $nPlicand) Then
$nPlier = $nPlicand
$nPlicand = $nPlier
EndIf
If $bTutor Then _
ConsoleWrite(StringFormat("Ethiopian multiplication of %d by %d...\n", $nPlier, $nPlicand))
While ($nPlier >= 1)
If Not IsEven($nPlier) Then
$nResult += $nPlicand
If $bTutor Then ConsoleWrite(StringFormat("%d\t%d\tKeep\n", $nPlier, $nPlicand))
Else
If $bTutor Then ConsoleWrite(StringFormat("%d\t%d\tStrike\n", $nPlier, $nPlicand))
EndIf
$nPlier = Halve($nPlier)
$nPlicand = Double($nPlicand)
WEnd
If $bTutor Then ConsoleWrite(StringFormat("Answer = %d\n", $nResult))
Return $nResult
EndFunc
MsgBox(0, "Ethiopian multiplication of 17 by 34", Ethiopian(17, 34) )
AWK
Implemented without the tutor.
function halve(x)
{
return int(x/2)
}
function double(x)
{
return x*2
}
function iseven(x)
{
return x%2 == 0
}
function ethiopian(plier, plicand)
{
r = 0
while(plier >= 1) {
if ( !iseven(plier) ) {
r += plicand
}
plier = halve(plier)
plicand = double(plicand)
}
return r
}
BEGIN {
print ethiopian(17, 34)
}
BASIC
Applesoft BASIC
Same code as Nascom BASIC
ASIC
REM Ethiopian multiplication
X = 17
Y = 34
TOT = 0
WHILE X >= 1
PRINT X;
PRINT " ";
A = X
GOSUB CHECKEVEN:
IF ISEVEN = 0 THEN
TOT = TOT + Y
PRINT Y;
ENDIF
PRINT
A = X
GOSUB HALVE:
X = A
A = Y
GOSUB DOUBLE:
Y = A
WEND
PRINT "= ";
PRINT TOT
END
REM Subroutines are required, though
REM they complicate the code
DOUBLE:
A = 2 * A
RETURN
HALVE:
A = A / 2
RETURN
CHECKEVEN:
REM ISEVEN - result (0 if A odd, 1 otherwise)
ISEVEN = A MOD 2
ISEVEN = 1 - ISEVEN
RETURN
- Output:
17 34 8 4 2 1 544 = 578
BASIC
Works with QBasic. While building the table, it's easier to simply not print unused values, rather than have to go back and strike them out afterward. (Both that and the actual adding happen in the "IF NOT (isEven(x))" block.)
DECLARE FUNCTION half% (a AS INTEGER)
DECLARE FUNCTION doub% (a AS INTEGER)
DECLARE FUNCTION isEven% (a AS INTEGER)
DIM x AS INTEGER, y AS INTEGER, outP AS INTEGER
x = 17
y = 34
DO
PRINT x,
IF NOT (isEven(x)) THEN
outP = outP + y
PRINT y
ELSE
PRINT
END IF
IF x < 2 THEN EXIT DO
x = half(x)
y = doub(y)
LOOP
PRINT " =", outP
FUNCTION doub% (a AS INTEGER)
doub% = a * 2
END FUNCTION
FUNCTION half% (a AS INTEGER)
half% = a \ 2
END FUNCTION
FUNCTION isEven% (a AS INTEGER)
isEven% = (a MOD 2) - 1
END FUNCTION
- Output:
17 34 8 4 2 1 544 = 578
BASIC256
outP = 0
x = 17
y = 34
while True
print x + chr(09);
if not (isEven(x)) then
outP += y
print y
else
print
end if
if x < 2 then exit while
x = half(x)
y = doub(y)
end while
print "=" + chr(09); outP
end
function doub (a)
return a * 2
end function
function half (a)
return a \ 2
end function
function isEven (a)
return (a mod 2) - 1
end function
BBC BASIC
x% = 17
y% = 34
REPEAT
IF NOT FNeven(x%) THEN
p% += y%
PRINT x%, y%
ELSE
PRINT x%, " ---"
ENDIF
x% = FNhalve(x%)
y% = FNdouble(y%)
UNTIL x% = 0
PRINT " " , " ==="
PRINT " " , p%
END
DEF FNdouble(A%) = A% * 2
DEF FNhalve(A%) = A% DIV 2
DEF FNeven(A%) = ((A% AND 1) = 0)
- Output:
17 34 8 --- 4 --- 2 --- 1 544 === 578
Chipmunk Basic
100 sub doub(a)
110 doub = a*2
120 end sub
130 sub half(a)
140 half = int(a/2)
150 end sub
160 sub iseven(a)
170 iseven = (a mod 2)-1
180 end sub
190 outp = 0
200 x = 17
210 y = 34
220 while 1
230 print x;chr$(9);
240 if not (iseven(x)) then
250 outp = outp - y
260 print y
270 else
280 print
290 endif
300 if x < 2 then exit while
310 x = half(x)
320 y = doub(y)
330 wend
340 print "=";chr$(9);outp
350 end
FreeBASIC
Function double_(y As String) As String
Var answer="0"+y
Var addcarry=0
For n_ As Integer=Len(y)-1 To 0 Step -1
Var addup=y[n_]+y[n_]-96
answer[n_+1]=(addup+addcarry) Mod 10+48
addcarry=(-(10<=(addup+addcarry)))
Next n_
answer[0]=addcarry+48
Return Ltrim(answer,"0")
End Function
Function Accumulate(NUM1 As String,NUM2 As String) As String
Var three="0"+NUM1
Var two=String(len(NUM1)-len(NUM2),"0")+NUM2
Var addcarry=0
For n2 As Integer=len(NUM1)-1 To 0 Step -1
Var addup=two[n2]+NUM1[n2]-96
three[n2+1]=(addup+addcarry) Mod 10+48
addcarry=(-(10<=(addup+addcarry)))
Next n2
three[0]=addcarry+48
three=Ltrim(three,"0")
If three="" Then Return "0"
Return three
End Function
Function Half(Byref x As String) As String
Var carry=0
For z As Integer=0 To Len(x)-1
Var temp=(x[z]-48+carry)
Var main=temp Shr 1
carry=(temp And 1) Shl 3 +(temp And 1) Shl 1
x[z]=main+48
Next z
x= Ltrim(x,"0")
Return x
End Function
Function IsEven(x As String) As Integer
If x[Len(x)-1] And 1 Then Return 0
return -1
End Function
Function EthiopianMultiply(n1 As String,n2 As String) As String
Dim As String x=n1,y=n2
If Len(y)>Len(x) Then Swap y,x
'set the largest one to be halfed
If Len(y)=Len(x) Then
If x<y Then Swap y,x
End If
Dim As String ans
Dim As String temprint,odd
While x<>""
temprint=""
odd=""
If not IsEven(x) Then
temprint=" *"
odd=" <-- odd"
ans=Accumulate(y,ans)
End If
Print x;odd;tab(30);y;temprint
x=Half(x)
y= Double_(y)
Wend
Return ans
End Function
'================= Example ====================
Print
Dim As String s1="17"
Dim As String s2="34"
Print "Half";tab(30);"Double * marks those accumulated"
print "Biggest";tab(30);"Smallest"
Print
Var ans= EthiopianMultiply(s1,s2)
Print
Print
Print "Final answer"
Print " ";ans
print "Float check"
Print Val(s1)*Val(s2)
Sleep
note: algorithm uses strings instead of integers
- Output:
Half Double * marks those accumulated Biggest Smallest 34 17 17 <-- odd 34 * 8 68 4 136 2 272 1 <-- odd 544 * Final answer 578 Float check 578
GW-BASIC
10 REM Ethiopian multiplication
20 DEF FNE(A%) = (A% + 1) MOD 2
30 DEF FNH(A%) = A% \ 2
40 DEF FND(A%) = 2 * A%
50 X% = 17: Y% = 34: TOT% = 0
60 WHILE X% >= 1
70 PRINT USING "###### "; X%;
80 IF FNE(X%)=0 THEN TOT% = TOT% + Y%: PRINT USING "###### "; Y% ELSE PRINT
90 X% = FNH(X%): Y% = FND(Y%)
100 WEND
110 PRINT USING "= ######"; TOT%
120 END
- Output:
17 34 8 4 2 1 544 = 578
Liberty BASIC
x = 17
y = 34
msg$ = str$(x) + " * " + str$(y) + " = "
Print str$(x) + " " + str$(y)
'In this routine we will not worry about discarding the right hand value whos left hand partner is even;
'we will just not add it to our product.
Do Until x < 2
If Not(isEven(x)) Then
product = (product + y)
End If
x = halveInt(x)
y = doubleInt(y)
Print str$(x) + " " + str$(y)
Loop
product = (product + y)
If (x < 0) Then product = (product * -1)
Print msg$ + str$(product)
Function isEven(num)
isEven = Abs(Not(num Mod 2))
End Function
Function halveInt(num)
halveInt = Int(num/ 2)
End Function
Function doubleInt(num)
doubleInt = Int(num * 2)
End Function
Microsoft Small Basic
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)
Minimal BASIC
10 REM Ethiopian multiplication
20 DEF FND(A) = 2*A
30 DEF FNH(A) = INT(A/2)
40 DEF FNE(A) = A-INT(A/2)*2-1
50 LET X = 17
60 LET Y = 34
70 LET T = 0
80 IF X < 1 THEN 170
90 IF FNE(X) <> 0 THEN 130
100 LET T = T+Y
110 PRINT X; TAB(9); Y; "(kept)"
120 GOTO 140
130 PRINT X; TAB(9); Y
140 LET X = FNH(X)
150 LET Y = FND(Y)
160 GOTO 80
170 PRINT "------------"
180 PRINT "= "; TAB(9); T; "(sum of kept second vals)"
190 END
MSX Basic
Same code as Nascom BASIC
Nascom BASIC
10 REM Ethiopian multiplication
20 DEF FND(A)=2*A
30 DEF FNH(A)=INT(A/2)
40 DEF FNE(A)=A-INT(A/2)*2-1
50 X=17
60 Y=34
70 TT=0
80 IF X<1 THEN 150
90 NR=X:GOSUB 1000:PRINT " ";
100 IF FNE(X)=0 THEN TT=TT+Y:NR=Y:GOSUB 1000
110 PRINT
120 X=FNH(X)
130 Y=FND(Y)
140 GOTO 80
150 PRINT "= ";
160 NR=TT:GOSUB 1000:PRINT
170 END
995 REM Print NR in 9 fields
1000 S$=STR$(NR)
1010 PRINT SPC(9-LEN(S$));S$;
1020 RETURN
- Output:
17 34 8 4 2 1 544 = 578
PureBasic
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
- Output:
Ethiopian multiplication of 17 and 34 ... equals 578
It became apparent that according to the way the Ethiopian method is described above it can't produce a correct result if the first multiplicand (the one being repeatedly halved) is negative. I've addressed that in this variation. If the first multiplicand is negative then the resulting sum (which may already be positive or negative) is negated.
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
- Output:
Ethiopian multiplication of 17 and 34 ... equals 578 Ethiopian multiplication of -17 and 34 ... equals -578 Ethiopian multiplication of -17 and -34 ... equals 578
QB64
PRINT multiply(17, 34)
SUB twice (n AS LONG)
n = n * 2
END SUB
SUB halve (n AS LONG)
n = n / 2
END SUB
FUNCTION odd%% (n AS LONG)
odd%% = (n AND 1) * -1
END FUNCTION
FUNCTION multiply& (a AS LONG, b AS LONG)
DIM AS LONG result, multiplicand, multiplier
multiplicand = a
multiplier = b
WHILE multiplicand <> 0
IF odd(multiplicand) THEN result = result + multiplier
halve multiplicand
twice multiplier
WEND
multiply& = result
END FUNCTION
- Output:
578
Sinclair ZX81 BASIC
Requires at least 2k of RAM. The specification is emphatic about wanting named functions: in a language where user-defined functions do not exist, the best we can do is to use subroutines and assign their line numbers to variables. This allows us to GOSUB HALVE
instead of having to GOSUB 320
. (It would however be more idiomatic to avoid using subroutines at all, for simple operations like these, and to refer to them by line number if they were used.)
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
- Input:
17 34
- Output:
17 34 8 4 2 1 544 578
Tiny BASIC
REM Ethiopian multiplication
LET X=17
LET Y=34
LET T=0
10 IF X<1 THEN GOTO 40
LET A=X
GOSUB 400
IF E=0 THEN GOTO 20
LET T=T+Y
PRINT X,", ",Y, " (kept)"
GOTO 30
20 PRINT X,", ",Y
30 GOSUB 300
LET X=A
LET A=Y
GOSUB 200
LET Y=A
GOTO 10
40 PRINT "------------"
PRINT "= ",T," (sum of kept second vals)"
END
REM Subroutines are required, though
REM they complicate the code
REM -- Double --
REM A - param.
200 LET A=2*A
RETURN
REM -- Halve --
REM A - param.
300 LET A=A/2
RETURN
REM -- Is even --
REM A - param.; E - result (0 - false)
400 LET E=A-(A/2)*2
RETURN
- Output:
17, 34 (kept) 8, 68 4, 136 2, 272 1, 544 (kept) ------------ = 578 (sum of kept second vals)
True BASIC
A translation of BBC BASIC. True BASIC does not have Boolean operations built-in.
!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
XBasic
' Ethiopian multiplication
PROGRAM "ethmult"
VERSION "0.0000"
DECLARE FUNCTION Entry()
INTERNAL FUNCTION Double(@a&&)
INTERNAL FUNCTION Halve(@a&&)
INTERNAL FUNCTION IsEven(a&&)
FUNCTION Entry()
x&& = 17
y&& = 34
tot&& = 0
DO WHILE x&& >= 1
PRINT FORMAT$("#########", x&&);
PRINT " ";
IFF IsEven(x&&) THEN
tot&& = tot&& + y&&
PRINT FORMAT$("#########", y&&);
END IF
PRINT
Halve(@x&&)
Double(@y&&)
LOOP
PRINT "= ";
PRINT FORMAT$("#########", tot&&);
PRINT
END FUNCTION
FUNCTION Double(a&&)
a&& = 2 * a&&
END FUNCTION
FUNCTION Halve(a&&)
a&& = a&& / 2
END FUNCTION
FUNCTION IsEven(a&&)
RETURN a&& MOD 2 = 0
END FUNCTION
END PROGRAM
- Output:
17 34 8 4 2 1 544 = 578
Yabasic
outP = 0
x = 17
y = 34
do
print x, chr$(09);
if not (isEven(x)) then
outP = outP + y
print y
else
print
fi
if x < 2 break
x = half(x)
y = doub(y)
loop
print "=", chr$(09), outP
end
sub doub (a)
return a * 2
end sub
sub half (a)
return int(a / 2)
end sub
sub isEven (a)
return mod(a, 2) - 1
end sub
Batch File
@echo off
:: Pick 2 random, non-zero, 2-digit numbers to send to :_main
set /a param1=%random% %% 98 + 1
set /a param2=%random% %% 98 + 1
call:_main %param1% %param2%
pause>nul
exit /b
:: This is the main function that outputs the answer in the form of "%1 * %2 = %answer%"
:_main
setlocal enabledelayedexpansion
set l0=%1
set r0=%2
set leftcount=1
set lefttempcount=0
set rightcount=1
set righttempcount=0
:: Creates an array ("l[]") with the :_halve function. %l0% is the initial left number parsed
:: This section will loop until the most recent member of "l[]" is equal to 0
:left
set /a lefttempcount=%leftcount%-1
if !l%lefttempcount%!==1 goto right
call:_halve !l%lefttempcount%!
set l%leftcount%=%errorlevel%
set /a leftcount+=1
goto left
:: Creates an array ("r[]") with the :_double function, %r0% is the initial right number parsed
:: This section will loop until it has the same amount of entries as "l[]"
:right
set /a righttempcount=%rightcount%-1
if %rightcount%==%leftcount% goto both
call:_double !r%righttempcount%!
set r%rightcount%=%errorlevel%
set /a rightcount+=1
goto right
:both
:: Creates an boolean array ("e[]") corresponding with whether or not the respective "l[]" entry is even
for /l %%i in (0,1,%lefttempcount%) do (
call:_even !l%%i!
set e%%i=!errorlevel!
)
:: Adds up all entries of "r[]" based on the value of "e[]", respectively
set answer=0
for /l %%i in (0,1,%lefttempcount%) do (
if !e%%i!==1 (
set /a answer+=!r%%i!
:: Everything from this-----------------------------
set iseven%%i=KEEP
) else (
set iseven%%i=STRIKE
)
echo L: !l%%i! R: !r%%i! - !iseven%%i!
:: To this, is for cosmetics and is optional--------
)
echo %l0% * %r0% = %answer%
exit /b
:: These are the three functions being used. The output of these functions are expressed in the errorlevel that they return
:_halve
setlocal
set /a temp=%1/2
exit /b %temp%
:_double
setlocal
set /a temp=%1*2
exit /b %temp%
:_even
setlocal
set int=%1
set /a modint=%int% %% 2
exit /b %modint%
- Output:
L: 17 R: 34 - KEEP L: 8 R: 68 - STRIKE L: 4 R: 136 - STRIKE L: 2 R: 272 - STRIKE L: 1 R: 544 - KEEP 17 * 34 = 578
BCPL
get "libhdr"
let halve(i) = i>>1
and double(i) = i<<1
and even(i) = (i&1) = 0
let emul(x, y) = emulr(x, y, 0)
and emulr(x, y, ac) =
x=0 -> ac,
emulr(halve(x), double(y), even(x) -> ac, ac + y)
let start() be writef("%N*N", emul(17, 34))
- Output:
578
Bracmat
( (halve=.div$(!arg.2))
& (double=.2*!arg)
& (isEven=.mod$(!arg.2):0)
& ( mul
= a b as bs newbs result
. !arg:(?as.?bs)
& whl
' ( !as:? (%@:~1:?a)
& !as halve$!a:?as
& !bs:? %@?b
& !bs double$!b:?bs
)
& :?newbs
& whl
' ( !as:%@?a ?as
& !bs:%@?b ?bs
& (isEven$!a|!newbs !b:?newbs)
)
& 0:?result
& whl
' (!newbs:%@?b ?newbs&!b+!result:?result)
& !result
)
& out$(mul$(17.34))
);
Output
578
BQN
Double ← 2⊸×
Halve ← ⌊÷⟜2
Odd ← 2⊸|
EMul ← {
times ← ↕⌈2⋆⁼𝕨
+´(Odd Halve⍟times 𝕨)/Double⍟times 𝕩
}
17 EMul 34
578
To avoid using a while loop, the iteration count is computed beforehand.
C
#include <stdio.h>
#include <stdbool.h>
void halve(int *x) { *x >>= 1; }
void doublit(int *x) { *x <<= 1; }
bool iseven(const int x) { return (x & 1) == 0; }
int ethiopian(int plier,
int plicand, const bool tutor)
{
int result=0;
if (tutor)
printf("ethiopian multiplication of %d by %d\n", plier, plicand);
while(plier >= 1) {
if ( iseven(plier) ) {
if (tutor) printf("%4d %6d struck\n", plier, plicand);
} else {
if (tutor) printf("%4d %6d kept\n", plier, plicand);
result += plicand;
}
halve(&plier); doublit(&plicand);
}
return result;
}
int main()
{
printf("%d\n", ethiopian(17, 34, true));
return 0;
}
C#
using System;
using System.Linq;
namespace RosettaCode.Tasks
{
public static class EthiopianMultiplication_Task
{
public static void Test ( )
{
Console.WriteLine ( "Ethiopian Multiplication" );
int A = 17, B = 34;
Console.WriteLine ( "Recursion: {0}*{1}={2}", A, B, EM_Recursion ( A, B ) );
Console.WriteLine ( "Linq: {0}*{1}={2}", A, B, EM_Linq ( A, B ) );
Console.WriteLine ( "Loop: {0}*{1}={2}", A, B, EM_Loop ( A, B ) );
Console.WriteLine ( );
}
public static int Halve ( this int p_Number )
{
return p_Number >> 1;
}
public static int Double ( this int p_Number )
{
return p_Number << 1;
}
public static bool IsEven ( this int p_Number )
{
return ( p_Number % 2 ) == 0;
}
public static int EM_Recursion ( int p_NumberA, int p_NumberB )
{
// Anchor Point, Recurse to find the next row Sum it with the second number according to the rules
return p_NumberA == 1 ? p_NumberB : EM_Recursion ( p_NumberA.Halve ( ), p_NumberB.Double ( ) ) + ( p_NumberA.IsEven ( ) ? 0 : p_NumberB );
}
public static int EM_Linq ( int p_NumberA, int p_NumberB )
{
// Creating a range from 1 to x where x the number of times p_NumberA can be halved.
// This will be 2^x where 2^x <= p_NumberA. Basically, ln(p_NumberA)/ln(2).
return Enumerable.Range ( 1, Convert.ToInt32 ( Math.Log ( p_NumberA, Math.E ) / Math.Log ( 2, Math.E ) ) + 1 )
// For every item (Y) in that range, create a new list, comprising the pair (p_NumberA,p_NumberB) Y times.
.Select ( ( item ) => Enumerable.Repeat ( new { Col1 = p_NumberA, Col2 = p_NumberB }, item )
// The aggregate method iterates over every value in the target list, passing the accumulated value and the current item's value.
.Aggregate ( ( agg_pair, orig_pair ) => new { Col1 = agg_pair.Col1.Halve ( ), Col2 = agg_pair.Col2.Double ( ) } ) )
// Remove all even items
.Where ( pair => !pair.Col1.IsEven ( ) )
// And sum!
.Sum ( pair => pair.Col2 );
}
public static int EM_Loop ( int p_NumberA, int p_NumberB )
{
int RetVal = 0;
while ( p_NumberA >= 1 )
{
RetVal += p_NumberA.IsEven ( ) ? 0 : p_NumberB;
p_NumberA = p_NumberA.Halve ( );
p_NumberB = p_NumberB.Double ( );
}
return RetVal;
}
}
}
C++
Using C++ templates, these kind of tasks can be implemented as meta-programs. The program runs at compile time, and the result is statically saved into regularly compiled code. Here is such an implementation without tutor, since there is no mechanism in C++ to output messages during program compilation.
template<int N>
struct Half
{
enum { Result = N >> 1 };
};
template<int N>
struct Double
{
enum { Result = N << 1 };
};
template<int N>
struct IsEven
{
static const bool Result = (N & 1) == 0;
};
template<int Multiplier, int Multiplicand>
struct EthiopianMultiplication
{
template<bool Cond, int Plier, int RunningTotal>
struct AddIfNot
{
enum { Result = Plier + RunningTotal };
};
template<int Plier, int RunningTotal>
struct AddIfNot <true, Plier, RunningTotal>
{
enum { Result = RunningTotal };
};
template<int Plier, int Plicand, int RunningTotal>
struct Loop
{
enum { Result = Loop<Half<Plier>::Result, Double<Plicand>::Result,
AddIfNot<IsEven<Plier>::Result, Plicand, RunningTotal >::Result >::Result };
};
template<int Plicand, int RunningTotal>
struct Loop <0, Plicand, RunningTotal>
{
enum { Result = RunningTotal };
};
enum { Result = Loop<Multiplier, Multiplicand, 0>::Result };
};
#include <iostream>
int main(int, char **)
{
std::cout << EthiopianMultiplication<17, 54>::Result << std::endl;
return 0;
}
Clojure
(defn halve [n]
(bit-shift-right n 1))
(defn twice [n] ; 'double' is taken
(bit-shift-left n 1))
(defn even [n] ; 'even?' is the standard fn
(zero? (bit-and n 1)))
(defn emult [x y]
(reduce +
(map second
(filter #(not (even (first %))) ; a.k.a. 'odd?'
(take-while #(pos? (first %))
(map vector
(iterate halve x)
(iterate twice y)))))))
(defn emult2 [x y]
(loop [a x, b y, r 0]
(if (= a 1)
(+ r b)
(if (even a)
(recur (halve a) (twice b) r)
(recur (halve a) (twice b) (+ r b))))))
CLU
halve = proc (n: int) returns (int)
return(n/2)
end halve
double = proc (n: int) returns (int)
return(n*2)
end double
even = proc (n: int) returns (bool)
return(n//2 = 0)
end even
e_mul = proc (a, b: int) returns (int)
total: int := 0
while (a > 0) do
if ~even(a) then total := total + b end
a := halve(a)
b := double(b)
end
return(total)
end e_mul
start_up = proc ()
po: stream := stream$primary_output()
stream$putl(po, int$unparse(e_mul(17, 34)))
end start_up
- Output:
578
COBOL
In COBOL, double is a reserved word, so the doubling functions is named twice, instead.
*>* Ethiopian multiplication
IDENTIFICATION DIVISION.
PROGRAM-ID. ethiopian-multiplication.
DATA DIVISION.
LOCAL-STORAGE SECTION.
01 l PICTURE 9(10) VALUE 17.
01 r PICTURE 9(10) VALUE 34.
01 ethiopian-multiply PICTURE 9(20).
01 product PICTURE 9(20).
PROCEDURE DIVISION.
CALL "ethiopian-multiply" USING
BY CONTENT l, BY CONTENT r,
BY REFERENCE ethiopian-multiply
END-CALL
DISPLAY ethiopian-multiply END-DISPLAY
MULTIPLY l BY r GIVING product END-MULTIPLY
DISPLAY product END-DISPLAY
STOP RUN.
END PROGRAM ethiopian-multiplication.
IDENTIFICATION DIVISION.
PROGRAM-ID. ethiopian-multiply.
DATA DIVISION.
LOCAL-STORAGE SECTION.
01 evenp PICTURE 9.
88 even VALUE 1.
88 odd VALUE 0.
LINKAGE SECTION.
01 l PICTURE 9(10).
01 r PICTURE 9(10).
01 product PICTURE 9(20) VALUE ZERO.
PROCEDURE DIVISION using l, r, product.
MOVE ZEROES TO product
PERFORM UNTIL l EQUAL ZERO
CALL "evenp" USING
BY CONTENT l,
BY REFERENCE evenp
END-CALL
IF odd
ADD r TO product GIVING product END-ADD
END-IF
CALL "halve" USING
BY CONTENT l,
BY REFERENCE l
END-CALL
CALL "twice" USING
BY CONTENT r,
BY REFERENCE r
END-CALL
END-PERFORM
GOBACK.
END PROGRAM ethiopian-multiply.
IDENTIFICATION DIVISION.
PROGRAM-ID. halve.
DATA DIVISION.
LOCAL-STORAGE SECTION.
LINKAGE SECTION.
01 n PICTURE 9(10).
01 m PICTURE 9(10).
PROCEDURE DIVISION USING n, m.
DIVIDE n BY 2 GIVING m END-DIVIDE
GOBACK.
END PROGRAM halve.
IDENTIFICATION DIVISION.
PROGRAM-ID. twice.
DATA DIVISION.
LOCAL-STORAGE SECTION.
LINKAGE SECTION.
01 n PICTURE 9(10).
01 m PICTURE 9(10).
PROCEDURE DIVISION USING n, m.
MULTIPLY n by 2 GIVING m END-MULTIPLY
GOBACK.
END PROGRAM twice.
IDENTIFICATION DIVISION.
PROGRAM-ID. evenp.
DATA DIVISION.
LOCAL-STORAGE SECTION.
01 q PICTURE 9(10).
LINKAGE SECTION.
01 n PICTURE 9(10).
01 m PICTURE 9(1).
88 even VALUE 1.
88 odd VALUE 0.
PROCEDURE DIVISION USING n, m.
DIVIDE n BY 2 GIVING q REMAINDER m END-DIVIDE
SUBTRACT m FROM 1 GIVING m END-SUBTRACT
GOBACK.
END PROGRAM evenp.
CoffeeScript
halve = (n) -> Math.floor n / 2
double = (n) -> n * 2
is_even = (n) -> n % 2 == 0
multiply = (a, b) ->
prod = 0
while a > 0
prod += b if !is_even a
a = halve a
b = double b
prod
# tests
do ->
for i in [0..100]
for j in [0..100]
throw Error("broken for #{i} * #{j}") if multiply(i,j) != i * j
CoffeeScript "One-liner"
ethiopian = (a, b, r=0) -> if a <= 0 then r else ethiopian a // 2, b * 2, if a % 2 then r + b else r
ColdFusion
Version with as a function of functions:
<cffunction name="double">
<cfargument name="number" type="numeric" required="true">
<cfset answer = number * 2>
<cfreturn answer>
</cffunction>
<cffunction name="halve">
<cfargument name="number" type="numeric" required="true">
<cfset answer = int(number / 2)>
<cfreturn answer>
</cffunction>
<cffunction name="even">
<cfargument name="number" type="numeric" required="true">
<cfset answer = number mod 2>
<cfreturn answer>
</cffunction>
<cffunction name="ethiopian">
<cfargument name="Number_A" type="numeric" required="true">
<cfargument name="Number_B" type="numeric" required="true">
<cfset Result = 0>
<cfloop condition = "Number_A GTE 1">
<cfif even(Number_A) EQ 1>
<cfset Result = Result + Number_B>
</cfif>
<cfset Number_A = halve(Number_A)>
<cfset Number_B = double(Number_B)>
</cfloop>
<cfreturn Result>
</cffunction>
<cfoutput>#ethiopian(17,34)#</cfoutput>
Version with display pizza:
<cfset Number_A = 17>
<cfset Number_B = 34>
<cfset Result = 0>
<cffunction name="double">
<cfargument name="number" type="numeric" required="true">
<cfset answer = number * 2>
<cfreturn answer>
</cffunction>
<cffunction name="halve">
<cfargument name="number" type="numeric" required="true">
<cfset answer = int(number / 2)>
<cfreturn answer>
</cffunction>
<cffunction name="even">
<cfargument name="number" type="numeric" required="true">
<cfset answer = number mod 2>
<cfreturn answer>
</cffunction>
<cfoutput>
Ethiopian multiplication of #Number_A# and #Number_B#...
<br>
<table width="512" border="0" cellspacing="20" cellpadding="0">
<cfloop condition = "Number_A GTE 1">
<cfif even(Number_A) EQ 1>
<cfset Result = Result + Number_B>
<cfset Action = "Keep">
<cfelse>
<cfset Action = "Strike">
</cfif>
<tr>
<td align="right">#Number_A#</td>
<td align="right">#Number_B#</td>
<td align="center">#Action#</td>
</tr>
<cfset Number_A = halve(Number_A)>
<cfset Number_B = double(Number_B)>
</cfloop>
</table>
...equals #Result#
</cfoutput>
Sample output:
Ethiopian multiplication of 17 and 34... 17 34 Keep 8 68 Strike 4 136 Strike 2 272 Strike 1 544 Keep ...equals 578
Common Lisp
Common Lisp already has evenp
, but all three of halve
, double
, and even-p
are locally defined within ethiopian-multiply
. (Note that the termination condition is (zerop l)
because we terminate 'after' the iteration wherein the left column contains 1, and (halve 1)
is 0.)
(defun ethiopian-multiply (l r)
(flet ((halve (n) (floor n 2))
(double (n) (* n 2))
(even-p (n) (zerop (mod n 2))))
(do ((product 0 (if (even-p l) product (+ product r)))
(l l (halve l))
(r r (double r)))
((zerop l) product))))
Craft Basic
let x = 17
let y = 34
let s = 0
do
if x < 1 then
break
endif
if s = 1 then
print x
endif
if s = 0 then
let s = 1
endif
let a = x
let e = a % 2
let e = 1 - e
if e = 0 then
let t = t + y
print x, " ", y
endif
let a = x
let a = int(a / 2)
let x = a
let a = y
let a = 2 * a
let y = a
loop x >= 1
print "="
print t
- Output:
17 348 4 2 1 1 544 =
578
D
int ethiopian(int n1, int n2) pure nothrow @nogc
in {
assert(n1 >= 0, "Multiplier can't be negative");
} body {
static enum doubleNum = (in int n) pure nothrow @nogc => n * 2;
static enum halveNum = (in int n) pure nothrow @nogc => n / 2;
static enum isEven = (in int n) pure nothrow @nogc => !(n & 1);
int result;
while (n1 >= 1) {
if (!isEven(n1))
result += n2;
n1 = halveNum(n1);
n2 = doubleNum(n2);
}
return result;
} unittest {
assert(ethiopian(77, 54) == 77 * 54);
assert(ethiopian(8, 923) == 8 * 923);
assert(ethiopian(64, -4) == 64 * -4);
}
void main() {
import std.stdio;
writeln("17 ethiopian 34 is ", ethiopian(17, 34));
}
- Output:
17 ethiopian 34 is 578
dc
0k [ Make sure we're doing integer division ]sx
[ 2 / ] sH [ Define "halve" function in register H ]sx
[ 2 * ] sD [ Define "double" function in register D ]sx
[ 2 % 1 r - ] sE [ Define "even?" function in register E ]sx
[ Entry into the main Ethiopian multiplication function is register M ]sx
[ Keeps running value for the product in register p ]sx
[ 0 sp lLx lp ] sM
[ The body of the main loop is in register L ]sx
[
sb sa [ First thing we do is cheat and store the parameters in
registers, which is safe because the only recursion is of
the tail variety. This avoids tricky stack
manipulations, which dc doesn't have good support for
(unlike, say, Forth). ]sx
la lEx sr [ r = even?(a) ]sx
lr 0 =S [ if r = 0 then call s]sx
la lHx d [ a = halve(a)]sx
lb lDx [ b = double(b)]sx
r 0 !=L [ if a !=0 then recurse ]
] sL
[ Utility macro that just adds the current value of b to the total in p ]sx
[ lp lb + sp ]sS
[ Demo by multiplying 17 and 34 ]sx
17 34 lMx p
- Output:
578
Delphi
See Pascal.
Draco
proc nonrec halve(word n) word: n >> 1 corp
proc nonrec double(word n) word: n << 1 corp
proc nonrec even(word n) bool: n & 1 = 0 corp
proc nonrec emul(word a, b) word:
word total;
total := 0;
while a > 0 do
if not even(a) then total := total + b fi;
a := halve(a);
b := double(b)
od;
total
corp
proc nonrec main() void: writeln(emul(17, 34)) corp
- Output:
578
E
def halve(&x) { x //= 2 }
def double(&x) { x *= 2 }
def even(x) { return x %% 2 <=> 0 }
def multiply(var a, var b) {
var ab := 0
while (a > 0) {
if (!even(a)) { ab += b }
halve(&a)
double(&b)
}
return ab
}
EasyLang
func mult x y .
while x >= 1
if x mod 2 <> 0
tot += y
.
x = x div 2
y *= 2
.
return tot
.
print mult 17 34
ed
H
,p
# decimal -> unary
g/[^0-9]\{1,\}/s///g
g/^0\{1,\}\([0-9]\)/s//\1/
g/^9\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiiii/
g/^8\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiii/
g/^7\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiii/
g/^6\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiii/
g/^5\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiii/
g/^4\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiii/
g/^3\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iii/
g/^2\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2ii/
g/^1\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2i/
g/^0\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2/
g/^9\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiiii/
g/^8\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiii/
g/^7\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiii/
g/^6\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiii/
g/^5\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiii/
g/^4\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiii/
g/^3\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iii/
g/^2\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2ii/
g/^1\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2i/
g/^0\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2/
g/^9\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiiii/
g/^8\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiii/
g/^7\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiii/
g/^6\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiii/
g/^5\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiii/
g/^4\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiii/
g/^3\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iii/
g/^2\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2ii/
g/^1\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2i/
g/^0\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2/
g/^9\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiiii/
g/^8\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiii/
g/^7\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiii/
g/^6\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiii/
g/^5\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiii/
g/^4\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiii/
g/^3\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iii/
g/^2\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2ii/
g/^1\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2i/
g/^0\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2/
g/^9\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiiii/
g/^8\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiiii/
g/^7\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiiii/
g/^6\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiiii/
g/^5\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiiii/
g/^4\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iiii/
g/^3\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2iii/
g/^2\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2ii/
g/^1\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2i/
g/^0\([0-9]*\)\(i*\)/s//\1\2\2\2\2\2\2\2\2\2\2/
# actual logic
1s/$/ /
,j
y
x
# Repeating the loop 10 times to be sure.
# Covers up to 1024 numbers.
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\
y\
x
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\
y\
x
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\
y\
x
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\
y\
x
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\
y\
x
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\
y\
x
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\
y\
x
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\
y\
x
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\
y\
x
$g/\(i\{1,\}\)\1i\{0,1\} \(i*\)/s//\1 \2\2/\
y\
x
$d
g/^\(i\{2\}\)*\>/d
g/^i* \(i*\)/s//\1/
,j
# unary -> decimal (up to 10^10)
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/
g/i/s/^\(i*\)\1\1\1\1\1\1\1\1\1\(i\{0,9\}\)/\1 \2/
g/i/s/[ ]$/ 0 /g
g/i/s/[ ][ ]/ 0 /g
g/i/s/[ ][ ]/ 0 /g
g/i/s/[ ]iiiiiiiii\>/ 9 /g
g/i/s/[ ]iiiiiiii\>/ 8 /g
g/i/s/[ ]iiiiiii\>/ 7 /g
g/i/s/[ ]iiiiii\>/ 6 /g
g/i/s/[ ]iiiii\>/ 5 /g
g/i/s/[ ]iiii\>/ 4 /g
g/i/s/[ ]iii\>/ 3 /g
g/i/s/[ ]ii\>/ 2 /g
g/i/s/[ ]i\>/ 1 /g
g/[ ]/s///g
g/^0\{1,\}\([0-9]\)/s//\1/
p
Q
- Output:
$ ed -s mul.input < ethiopian-mul.ed Newline appended 17 34 578
Eiffel
class
APPLICATION
create
make
feature {NONE}
make
do
io.put_integer (ethiopian_multiplication (17, 34))
end
ethiopian_multiplication (a, b: INTEGER): INTEGER
-- Product of 'a' and 'b'.
require
a_positive: a > 0
b_positive: b > 0
local
x, y: INTEGER
do
x := a
y := b
from
until
x <= 0
loop
if not is_even_int (x) then
Result := Result + y
end
x := halve_int (x)
y := double_int (y)
end
ensure
Result_correct: Result = a * b
end
feature {NONE}
double_int (n: INTEGER): INTEGER
--Two times 'n'.
do
Result := n * 2
end
halve_int (n: INTEGER): INTEGER
--'n' divided by two.
do
Result := n // 2
end
is_even_int (n: INTEGER): BOOLEAN
--Is 'n' an even integer?
do
Result := n \\ 2 = 0
end
end
- Output:
578
Ela
Translation of Haskell:
open list number
halve x = x `div` 2
double = (2*)
ethiopicmult a b = sum <| map snd <| filter (odd << fst) <| zip
(takeWhile (>=1) <| iterate halve a)
(iterate double b)
ethiopicmult 17 34
- Output:
578
Elixir
defmodule Ethiopian do
def halve(n), do: div(n, 2)
def double(n), do: n * 2
def even(n), do: rem(n, 2) == 0
def multiply(lhs, rhs) when is_integer(lhs) and lhs > 0 and is_integer(rhs) and rhs > 0 do
multiply(lhs, rhs, 0)
end
def multiply(1, rhs, acc), do: rhs + acc
def multiply(lhs, rhs, acc) do
if even(lhs), do: multiply(halve(lhs), double(rhs), acc),
else: multiply(halve(lhs), double(rhs), acc+rhs)
end
end
IO.inspect Ethiopian.multiply(17, 34)
- Output:
578
Emacs Lisp
Emacs Lisp has cl-evenp
in cl-lib.el (its Common Lisp library), but for the sake of completeness the desired effect is achieved here via mod
.
(defun even-p (n)
(= (mod n 2) 0))
(defun halve (n)
(floor n 2))
(defun double (n)
(* n 2))
(defun ethiopian-multiplication (l r)
(let ((sum 0))
(while (>= l 1)
(unless (even-p l)
(setq sum (+ r sum)))
(setq l (halve l))
(setq r (double r)))
sum))
EMal
fun halve = int by int value do return value / 2 end
fun double = int by int value do return value * 2 end
fun isEven = logic by int value do return value % 2 == 0 end
fun ethiopian = int by int multiplicand, int multiplier
int product
while multiplicand >= 1
if not isEven(multiplicand) do product += multiplier end
multiplicand = halve(multiplicand)
multiplier = double(multiplier)
end
return product
end
writeLine(ethiopian(17, 34))
- Output:
578
Erlang
-module(ethopian).
-export([multiply/2]).
halve(N) ->
N div 2.
double(N) ->
N * 2.
even(N) ->
(N rem 2) == 0.
multiply(LHS,RHS) when is_integer(Lhs) and Lhs > 0 and
is_integer(Rhs) and Rhs > 0 ->
multiply(LHS,RHS,0).
multiply(1,RHS,Acc) ->
RHS+Acc;
multiply(LHS,RHS,Acc) ->
case even(LHS) of
true ->
multiply(halve(LHS),double(RHS),Acc);
false ->
multiply(halve(LHS),double(RHS),Acc+RHS)
end.
ERRE
PROGRAM ETHIOPIAN_MULT
FUNCTION EVEN(A)
EVEN=(A+1) MOD 2
END FUNCTION
FUNCTION HALF(A)
HALF=INT(A/2)
END FUNCTION
FUNCTION DOUBLE(A)
DOUBLE=2*A
END FUNCTION
BEGIN
X=17 Y=34 TOT=0
WHILE X>=1 DO
PRINT(X,)
IF EVEN(X)=0 THEN TOT=TOT+Y PRINT(Y) ELSE PRINT END IF
X=HALF(X) Y=DOUBLE(Y)
END WHILE
PRINT("=",TOT)
END PROGRAM
- Output:
17 34 8 4 2 1 544 = 578
Euphoria
function emHalf(integer n)
return floor(n/2)
end function
function emDouble(integer n)
return n*2
end function
function emIsEven(integer n)
return (remainder(n,2) = 0)
end function
function emMultiply(integer a, integer b)
integer sum
sum = 0
while (a) do
if (not emIsEven(a)) then sum += b end if
a = emHalf(a)
b = emDouble(b)
end while
return sum
end function
----------------------------------------------------------------
-- runtime
printf(1,"emMultiply(%d,%d) = %d\n",{17,34,emMultiply(17,34)})
printf(1,"\nPress Any Key\n",{})
while (get_key() = -1) do end while
F#
let ethopian n m =
let halve n = n / 2
let double n = n * 2
let even n = n % 2 = 0
let rec loop n m result =
if n <= 1 then result + m
else if even n then loop (halve n) (double m) result
else loop (halve n) (double m) (result + m)
loop n m 0
Factor
USING: arrays kernel math multiline sequences ;
IN: ethiopian-multiplication
/*
This function is built-in
: odd? ( n -- ? ) 1 bitand 1 number= ;
*/
: double ( n -- 2*n ) 2 * ;
: halve ( n -- n/2 ) 2 /i ;
: ethiopian-mult ( a b -- a*b )
[ 0 ] 2dip
[ dup 0 > ] [
[ odd? [ + ] [ drop ] if ] 2keep
[ double ] [ halve ] bi*
] while 2drop ;
FALSE
[2/]h:
[2*]d:
[$2/2*-]o:
[0[@$][$o;![@@\$@+@]?h;!@d;!@]#%\%]m:
17 34m;!. {578}
Forth
Halve and double are standard words, spelled 2/ and 2* respectively.
: even? ( n -- ? ) 1 and 0= ;
: e* ( x y -- x*y )
dup 0= if nip exit then
over 2* over 2/ recurse
swap even? if nip else + then ;
The author of Forth, Chuck Moore, designed a similar primitive into his MISC Forth microprocessors. The +* instruction is a multiply step: it adds S to T if A is odd, then shifts both A and T right one. The idea is that you only need to perform as many of these multiply steps as you have significant bits in the operand.(See his core instruction set for details.)
Fortran
program EthiopicMult
implicit none
print *, ethiopic(17, 34, .true.)
contains
subroutine halve(v)
integer, intent(inout) :: v
v = int(v / 2)
end subroutine halve
subroutine doublit(v)
integer, intent(inout) :: v
v = v * 2
end subroutine doublit
function iseven(x)
logical :: iseven
integer, intent(in) :: x
iseven = mod(x, 2) == 0
end function iseven
function ethiopic(multiplier, multiplicand, tutorialized) result(r)
integer :: r
integer, intent(in) :: multiplier, multiplicand
logical, intent(in), optional :: tutorialized
integer :: plier, plicand
logical :: tutor
plier = multiplier
plicand = multiplicand
if ( .not. present(tutorialized) ) then
tutor = .false.
else
tutor = tutorialized
endif
r = 0
if ( tutor ) write(*, '(A, I0, A, I0)') "ethiopian multiplication of ", plier, " by ", plicand
do while(plier >= 1)
if ( iseven(plier) ) then
if (tutor) write(*, '(I4, " ", I6, A)') plier, plicand, " struck"
else
if (tutor) write(*, '(I4, " ", I6, A)') plier, plicand, " kept"
r = r + plicand
endif
call halve(plier)
call doublit(plicand)
end do
end function ethiopic
end program EthiopicMult
Fōrmulæ
Fōrmulæ programs are not textual, visualization/edition of programs is done showing/manipulating structures but not text. Moreover, there can be multiple visual representations of the same program. Even though it is possible to have textual representation —i.e. XML, JSON— they are intended for storage and transfer purposes more than visualization and edition.
Programs in Fōrmulæ are created/edited online in its website.
In this page you can see and run the program(s) related to this task and their results. You can also change either the programs or the parameters they are called with, for experimentation, but remember that these programs were created with the main purpose of showing a clear solution of the task, and they generally lack any kind of validation.
Solution
Test case
Because the required functions are either simple or intrinsic, the solution can be much simpler:
FutureBasic
local fn Doubled( n as long ) : end fn = n * 2
local fn Halved( n as long ) : end fn = int( n / 2 )
local fn IsEven( n as long ) : end fn = ( n mod 2 ) - 1
local fn EthiopianMultiply( x as long, y as long )
long sum = 0, sign = x
printf @"Ethiopian multiplication of %3ld x %3ld = \b", x, y
do
if not ( fn IsEven( x ) ) then sum += y
x = fn Halved( x ) : y = fn Doubled( y )
until ( x == 0 )
if sign < 0 then sum *= - 1
printf @"%4ld", sum
end fn
fn EthiopianMultiply( 17, 34 )
fn EthiopianMultiply( -17, 34 )
fn EthiopianMultiply( -17, -34 )
HandleEvents
- Output:
Ethiopian multiplication of 17 x 34 = 578 Ethiopian multiplication of -17 x 34 = -578 Ethiopian multiplication of -17 x -34 = 578
Go
package main
import "fmt"
func halve(i int) int { return i/2 }
func double(i int) int { return i*2 }
func isEven(i int) bool { return i%2 == 0 }
func ethMulti(i, j int) (r int) {
for ; i > 0; i, j = halve(i), double(j) {
if !isEven(i) {
r += j
}
}
return
}
func main() {
fmt.Printf("17 ethiopian 34 = %d\n", ethMulti(17, 34))
}
Haskell
Using integer (+)
import Prelude hiding (odd)
import Control.Monad (join)
halve :: Int -> Int
halve = (`div` 2)
double :: Int -> Int
double = join (+)
odd :: Int -> Bool
odd = (== 1) . (`mod` 2)
ethiopicmult :: Int -> Int -> Int
ethiopicmult a b =
sum $
map snd $
filter (odd . fst) $
zip (takeWhile (>= 1) $ iterate halve a) (iterate double b)
main :: IO ()
main = print $ ethiopicmult 17 34 == 17 * 34
- Output:
*Main> ethiopicmult 17 34 578
Fold after unfold
Logging the stages of the unfoldr and foldr applications:
import Data.List (inits, intercalate, unfoldr)
import Data.Tuple (swap)
import Debug.Trace (trace)
----------------- ETHIOPIAN MULTIPLICATION ---------------
ethMult :: Int -> Int -> Int
ethMult n m =
( trace
=<< (<> "\n")
. ((showDoubles pairs <> " = ") <>)
. show
)
(foldr addedWhereOdd 0 pairs)
where
pairs = zip (unfoldr halved n) (iterate doubled m)
doubled x = x + x
halved h
| 0 < h =
Just $
trace
(showHalf h)
(swap $ quotRem h 2)
| otherwise = Nothing
addedWhereOdd (d, x) a
| 0 < d = (+) a x
| otherwise = a
---------------------- TRACE DISPLAY ---------------------
showHalf :: Int -> String
showHalf x = "halve: " <> rjust 6 ' ' (show (quotRem x 2))
showDoubles :: [(Int, Int)] -> String
showDoubles xs =
"double:\n"
<> unlines (go <$> xs)
<> intercalate " + " (xs >>= f)
where
go x
| 0 < fst x = "-> " <> rjust 3 ' ' (show $ snd x)
| otherwise = rjust 6 ' ' $ show $ snd x
f (r, q)
| 0 < r = [show q]
| otherwise = []
rjust :: Int -> Char -> String -> String
rjust n c s = drop (length s) (replicate n c <> s)
--------------------------- TEST -------------------------
main :: IO ()
main = do
print $ ethMult 17 34
print $ ethMult 34 17
- Output:
halve: (8,1) halve: (4,0) halve: (2,0) halve: (1,0) halve: (0,1) double: -> 34 68 136 272 -> 544 34 + 544 = 578 halve: (17,0) halve: (8,1) halve: (4,0) halve: (2,0) halve: (1,0) halve: (0,1) double: 17 -> 34 68 136 272 -> 544 34 + 544 = 578 578 578
Using monoid mappend
Alternatively, we can express Ethiopian multiplication in terms of mappend and mempty, in place of (+) and 0.
This additional generality means that our ethMult function can now replicate a string n times as readily as it multiplies an integer n times, or raises an integer to the nth power.
import Control.Monad (join)
import Data.List (unfoldr)
import Data.Monoid (getProduct, getSum)
import Data.Tuple (swap)
----------------- ETHIOPIAN MULTIPLICATION ---------------
ethMult :: (Monoid m) => Int -> m -> m
ethMult n m =
foldr addedWhereOdd mempty $
zip (unfoldr half n) $ iterate (join (<>)) m
half :: Integral b => b -> Maybe (b, b)
half n
| 0 /= n = Just . swap $ quotRem n 2
| otherwise = Nothing
addedWhereOdd :: (Eq a, Num a, Semigroup p) => (a, p) -> p -> p
addedWhereOdd (d, x) a
| 0 /= d = a <> x
| otherwise = a
--------------------------- TEST -------------------------
main :: IO ()
main = do
mapM_ print $
[ getSum $ ethMult 17 34, -- 34 * 17
getProduct $ ethMult 3 34 -- 34 ^ 3
]
-- [3 ^ 17, 4 ^ 17]
<> (getProduct <$> ([ethMult 17] <*> [3, 4]))
print $ ethMult 17 "34"
print $ ethMult 17 [3, 4]
- Output:
578 39304 129140163 17179869184 "3434343434343434343434343434343434" [3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4,3,4]
HicEst
WRITE(Messagebox) ethiopian( 17, 34 )
END ! of "main"
FUNCTION ethiopian(x, y)
ethiopian = 0
left = x
right = y
DO i = x, 1, -1
IF( isEven(left) == 0 ) ethiopian = ethiopian + right
IF( left == 1 ) RETURN
left = halve(left)
right = double(right)
ENDDO
END
FUNCTION halve( x )
halve = INT( x/2 )
END
FUNCTION double( x )
double = 2 * x
END
FUNCTION isEven( x )
isEven = MOD(x, 2) == 0
END
Icon and Unicon
While not it seems a task requirement, most implementations have a tutorial version. This seemed easiest in an iterative version.
J
Solution:
double =: 2&*
halve =: %&2 NB. or the primitive -:
odd =: 2&|
ethiop =: +/@(odd@] # (double~ <@#)) (1>.<.@halve)^:a:
Example:
17 ethiop 34 578
Note that double
will repeatedly double its right argument if given a repetition count for its left argument:
(<5) double 17 17 34 68 136 272
Note: this implementation assumes that the number on the right is a positive integer. In contexts where it can be negative, its absolute value should be used and you should multiply the result of ethiop by its sign.
ethio=: *@] * (ethiop |)
Alternatively, if multiplying by negative 1 is prohibited, you can use a conditional function which optionally negates its argument.
ethio=: *@] -@]^:(0 > [) (ethiop |)
Examples:
7 ethio 11
77
7 ethio _11
_77
_7 ethio 11
_77
_7 ethio _11
77
Java
import java.util.HashMap;
import java.util.Map;
import java.util.Scanner;
public class Mult{
public static void main(String[] args){
Scanner sc = new Scanner(System.in);
int first = sc.nextInt();
int second = sc.nextInt();
if(first < 0){
first = -first;
second = -second;
}
Map<Integer, Integer> columns = new HashMap<Integer, Integer>();
columns.put(first, second);
int sum = isEven(first)? 0 : second;
do{
first = halveInt(first);
second = doubleInt(second);
columns.put(first, second);
if(!isEven(first)){
sum += second;
}
}while(first > 1);
System.out.println(sum);
}
public static int doubleInt(int doubleMe){
return doubleMe << 1; //shift left
}
public static int halveInt(int halveMe){
return halveMe >>> 1; //shift right
}
public static boolean isEven(int num){
return (num & 1) == 0;
}
}
An optimised variant using the three helper functions from the other example.
/**
* This method will use ethiopian styled multiplication.
* @param a Any non-negative integer.
* @param b Any integer.
* @result a multiplied by b
*/
public static int ethiopianMultiply(int a, int b) {
if(a==0 || b==0) {
return 0;
}
int result = 0;
while(a>=1) {
if(!isEven(a)) {
result+=b;
}
b = doubleInt(b);
a = halveInt(a);
}
return result;
}
/**
* This method is an improved version that will use
* ethiopian styled multiplication, and also
* supports negative parameters.
* @param a Any integer.
* @param b Any integer.
* @result a multiplied by b
*/
public static int ethiopianMultiplyWithImprovement(int a, int b) {
if(a==0 || b==0) {
return 0;
}
if(a<0) {
a=-a;
b=-b;
} else if(b>0 && a>b) {
int tmp = a;
a = b;
b = tmp;
}
int result = 0;
while(a>=1) {
if(!isEven(a)) {
result+=b;
}
b = doubleInt(b);
a = halveInt(a);
}
return result;
}
JavaScript
var eth = {
halve : function ( n ){ return Math.floor(n/2); },
double: function ( n ){ return 2*n; },
isEven: function ( n ){ return n%2 === 0); },
mult: function ( a , b ){
var sum = 0, a = [a], b = [b];
while ( a[0] !== 1 ){
a.unshift( eth.halve( a[0] ) );
b.unshift( eth.double( b[0] ) );
}
for( var i = a.length - 1; i > 0 ; i -= 1 ){
if( !eth.isEven( a[i] ) ){
sum += b[i];
}
}
return sum + b[0];
}
}
// eth.mult(17,34) returns 578
Or, avoiding the use of a multiplication operator in the version above, we can alternatively:
- Halve an integer, in this sense, with a right-shift (n >>= 1)
- Double an integer by addition to self (m += m)
- Test if an integer is odd by bitwise and (n & 1)
function ethMult(m, n) {
var o = !isNaN(m) ? 0 : ''; // same technique works with strings
if (n < 1) return o;
while (n > 1) {
if (n & 1) o += m; // 3. integer odd/even? (bit-wise and 1)
n >>= 1; // 1. integer halved (by right-shift)
m += m; // 2. integer doubled (addition to self)
}
return o + m;
}
ethMult(17, 34)
- Output:
578
Note that the same function will also multiply strings with some efficiency, particularly where n is larger. See Repeat_a_string
ethMult('Ethiopian', 34)
- Output:
"EthiopianEthiopianEthiopianEthiopianEthiopianEthiopian EthiopianEthiopianEthiopianEthiopianEthiopianEthiopianEthiopian EthiopianEthiopianEthiopianEthiopianEthiopianEthiopianEthiopian EthiopianEthiopianEthiopianEthiopianEthiopianEthiopianEthiopian EthiopianEthiopianEthiopianEthiopianEthiopianEthiopianEthiopian"
jq
The following implementation is intended for jq 1.4 and later.
If your jq has while/2, then the implementation of the inner function, pairs, can be simplified to:
def pairs: while( .[0] > 0; [ (.[0] | halve), (.[1] | double) ]);
def halve: (./2) | floor;
def double: 2 * .;
def isEven: . % 2 == 0;
def ethiopian_multiply(a;b):
def pairs: recurse( if .[0] > 0
then [ (.[0] | halve), (.[1] | double) ]
else empty
end );
reduce ([a,b] | pairs
| select( .[0] | isEven | not)
| .[1] ) as $i
(0; . + $i) ;
Example:
ethiopian_multiply(17;34) # => 578
Jsish
From Javascript entry.
/* Ethiopian multiplication in Jsish */
var eth = {
halve : function(n) { return Math.floor(n / 2); },
double: function(n) { return n << 1; },
isEven: function(n) { return n % 2 === 0; },
mult: function(a, b){
var sum = 0;
a = [a], b = [b];
while (a[0] !== 1) {
a.unshift(eth.halve(a[0]));
b.unshift(eth.double(b[0]));
}
for (var i = a.length - 1; i > 0; i -= 1) {
if(!eth.isEven(a[i])) sum += b[i];
}
return sum + b[0];
}
};
;eth.mult(17,34);
/*
=!EXPECTSTART!=
eth.mult(17,34) ==> 578
=!EXPECTEND!=
*/
- Output:
prompt$ jsish -u ethiopianMultiplication.jsi [PASS] ethiopianMultiplication.jsi
Julia
Helper functions (type stable):
halve(x::Integer) = x >> one(x)
double(x::Integer) = Int8(2) * x
even(x::Integer) = x & 1 != 1
Main function:
function ethmult(a::Integer, b::Integer)
r = 0
while a > 0
r += b * !even(a)
a = halve(a)
b = double(b)
end
return r
end
@show ethmult(17, 34)
Array version (more similar algorithm to the one from the task description):
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)])
end
@show ethmult2(17, 34)
- Output:
ethmult(17, 34) = 578 ethmult2(17, 34) = 578
Benchmark test:
julia> @time ethmult(17, 34) 0.000003 seconds (5 allocations: 176 bytes) 578 julia> @time ethmult2(17, 34) 0.000007 seconds (18 allocations: 944 bytes) 578
Kotlin
// version 1.1.2
fun halve(n: Int) = n / 2
fun double(n: Int) = n * 2
fun isEven(n: Int) = n % 2 == 0
fun ethiopianMultiply(x: Int, y: Int): Int {
var xx = x
var yy = y
var sum = 0
while (xx >= 1) {
if (!isEven(xx)) sum += yy
xx = halve(xx)
yy = double(yy)
}
return sum
}
fun main(args: Array<String>) {
println("17 x 34 = ${ethiopianMultiply(17, 34)}")
println("99 x 99 = ${ethiopianMultiply(99, 99)}")
}
- Output:
17 x 34 = 578 99 x 99 = 9801
Literally follow the algorithm using generateSequence()
fun Int.halve() = this shr 1
fun Int.double() = this shl 1
fun Int.isOdd() = this and 1 == 1
fun ethiopianMultiply(n: Int, m: Int): Int =
generateSequence(Pair(n, m)) { p -> Pair(p.first.halve(), p.second.double()) }
.takeWhile { it.first >= 1 }.filter { it.first.isOdd() }.sumOf { it.second }
fun main() {
ethiopianMultiply(17, 34).also { println(it) } // 578
ethiopianMultiply(99, 99).also { println(it) } // 9801
ethiopianMultiply(4, 8).also { println(it) } // 32
}
Lambdatalk
A translation from the javascript entry.
{def halve {lambda {:n} {floor {/ :n 2}}}}
-> halve
{def double {lambda {:n} {* 2 :n}}}
-> double
{def isEven {lambda {:n} {= {% :n 2} 0}}}
-> isEven
{def mult
{def mult.r
{lambda {:a :b}
{if {= {A.first :a} 1}
then {+ {S.map {{lambda {:a :b :i}
{if {isEven {A.get :i :a}}
then else {A.get :i :b}}} :a :b}
{S.serie {- {A.length :a} 1} 0 -1}}}
else {mult.r {A.addfirst! {halve {A.first :a}} :a}
{A.addfirst! {double {A.first :b}} :b}}}}}
{lambda {:a :b}
{mult.r {A.new :a} {A.new :b}}}}
-> mult
{mult 17 34}
-> 578
Limbo
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;
}
Locomotive Basic
10 DEF FNiseven(a)=(a+1) MOD 2
20 DEF FNhalf(a)=INT(a/2)
30 DEF FNdouble(a)=2*a
40 x=17:y=34:tot=0
50 WHILE x>=1
60 PRINT x,
70 IF FNiseven(x)=0 THEN tot=tot+y:PRINT y ELSE PRINT
80 x=FNhalf(x):y=FNdouble(y)
90 WEND
100 PRINT "=", tot
Output:
17 34 8 4 2 1 544 = 578
Logo
to double :x
output ashift :x 1
end
to halve :x
output ashift :x -1
end
to even? :x
output equal? 0 bitand 1 :x
end
to eproduct :x :y
if :x = 0 [output 0]
ifelse even? :x ~
[output eproduct halve :x double :y] ~
[output :y + eproduct halve :x double :y]
end
LOLCODE
HAI 1.3
HOW IZ I Halve YR Integer
FOUND YR QUOSHUNT OF Integer AN 2
IF U SAY SO
HOW IZ I Dubble YR Integer
FOUND YR PRODUKT OF Integer AN 2
IF U SAY SO
HOW IZ I IzEven YR Integer
FOUND YR BOTH SAEM 0 AN MOD OF Integer AN 2
IF U SAY SO
HOW IZ I EthiopianProdukt YR a AN YR b
I HAS A Result ITZ 0
IM IN YR Loop UPPIN YR x WILE DIFFRINT a AN 0
NOT I IZ IzEven YR a MKAY
O RLY?
YA RLY
Result R SUM OF Result AN b
OIC
a R I IZ Halve YR a MKAY
b R I IZ Dubble YR b MKAY
IM OUTTA YR Loop
FOUND YR Result
IF U SAY SO
VISIBLE I IZ EthiopianProdukt YR 17 AN YR 34 MKAY
KTHXBYE
Output:
578
Lua
function halve(a)
return a/2
end
function double(a)
return a*2
end
function isEven(a)
return a%2 == 0
end
function ethiopian(x, y)
local result = 0
while (x >= 1) do
if not isEven(x) then
result = result + y
end
x = math.floor(halve(x))
y = double(y)
end
return result;
end
print(ethiopian(17, 34))
M2000 Interpreter
Module EthiopianMultiplication{
Form 60, 25
Const Center=2, ColumnWith=12
Report Center,"Ethiopian Method of Multiplication"
// using decimals as unsigned integers
Def Decimal leftval, rightval, sum
(leftval, rightval)=(random(1, 65535), random(1, 65536))
Print $( , ColumnWith), "Target:", leftval*rightval,
Hex leftval*rightval
sum=0
if @IsEven(leftval) Else sum+=rightval
Print leftval, rightval,
Hex leftval, rightval
while leftval>1
leftval=@halveInt(leftval)
rightval=@DoubleInt(rightval)
Print leftval, rightval,
Hex leftval, rightval
if @IsEven(leftval) Else sum+=rightval
End while
Print "", sum
Hex "", sum
Function HalveInt(i)
=Binary.Shift(i,-1)
End Function
Function DoubleInt(i)
=Binary.Shift(i,1)
End Function
Function IsEven(i)
=Binary.And(i, 1)=0
End Function
}
EthiopianMultiplication
Mathematica / Wolfram Language
IntegerHalving[x_]:=Floor[x/2]
IntegerDoubling[x_]:=x*2;
OddInteger OddQ
Ethiopian[x_, y_] :=
Total[Select[NestWhileList[{IntegerHalving[#[[1]]],IntegerDoubling[#[[2]]]}&, {x,y}, (#[[1]]>1&)], OddQ[#[[1]]]&]][[2]]
Ethiopian[17, 34]
Output:
578
MATLAB
First we define the three subroutines needed for this task. These must be saved in their own individual ".m" files. The file names must be the same as the function name stored in that file. Also, they must be saved in the same directory as the script that performs the Ethiopian Multiplication.
In addition, with the exception of the "isEven" and "doubleInt" functions, the inputs of the functions have to be an integer data type. This means that the input to these functions must be coerced from the default IEEE754 double precision floating point data type that all numbers and variables are represented as, to integer data types. As of MATLAB 2007a, 64-bit integer arithmetic is not supported. So, at best, these will work for 32-bit integer data types.
halveInt.m:
function result = halveInt(number)
result = idivide(number,2,'floor');
end
doubleInt.m:
function result = doubleInt(number)
result = times(2,number);
end
isEven.m:
%Returns a logical 1 if the number is even, 0 otherwise.
function trueFalse = isEven(number)
trueFalse = logical( mod(number,2)==0 );
end
ethiopianMultiplication.m:
function answer = ethiopianMultiplication(multiplicand,multiplier)
%Generate columns
while multiplicand(end)>1
multiplicand(end+1,1) = halveInt( multiplicand(end) );
multiplier(end+1,1) = doubleInt( multiplier(end) );
end
%Strike out appropriate rows
multiplier( isEven(multiplicand) ) = [];
%Generate answer
answer = sum(multiplier);
end
Sample input: (with data type coercion)
ethiopianMultiplication( int32(17),int32(34) )
ans =
578
Maxima
/* Function to halve */
halve(n):=floor(n/2)$
/* Function to double */
double(n):=2*n$
/* Predicate function to check wether an integer is even */
my_evenp(n):=if mod(n,2)=0 then true$
/* Function that implements ethiopian function using the three previously defined functions */
ethiopian(n1,n2):=block(cn1:n1,cn2:n2,list_w:[],
while cn1>0 do (list_w:endcons(cn1,list_w),cn1:halve(cn1)),
n2_list:append([cn2],makelist(cn2:double(cn2),length(list_w)-1)),
sublist_indices(list_w,lambda([x],not my_evenp(x))),
makelist(n2_list[i],i,%%),
apply("+",%%))$
Metafont
Implemented without the tutor.
vardef halve(expr x) = floor(x/2) enddef;
vardef double(expr x) = x*2 enddef;
vardef iseven(expr x) = if (x mod 2) = 0: true else: false fi enddef;
primarydef a ethiopicmult b =
begingroup
save r_, plier_, plicand_;
plier_ := a; plicand_ := b;
r_ := 0;
forever: exitif plier_ < 1;
if not iseven(plier_): r_ := r_ + plicand_; fi
plier_ := halve(plier_);
plicand_ := double(plicand_);
endfor
r_
endgroup
enddef;
show( (17 ethiopicmult 34) );
end
МК-61/52
П1 П2 <-> П0
ИП0 1 - x#0 29
ИП1 2 * П1
ИП0 2 / [x] П0
2 / {x} x#0 04 ИП2 ИП1 + П2
БП 04
ИП2 С/П
MMIX
In order to assemble and run this program you'll have to install MMIXware from [1]. This provides you with a simple assembler, a simulator, example programs and full documentation.
A IS 17
B IS 34
pliar IS $255 % designating main registers
pliand GREG
acc GREG
str IS pliar % reuse reg $255 for printing
LOC Data_Segment
GREG @
BUF OCTA #3030303030303030 % reserve a buffer that is big enough to hold
OCTA #3030303030303030 % a max (signed) 64 bit integer:
OCTA #3030300a00000000 % 2^63 - 1 = 9223372036854775807
% string is terminated with NL, 0
LOC #1000 % locate program at address
GREG @
halve SR pliar,pliar,1
GO $127,$127,0
double SL pliand,pliand,1
GO $127,$127,0
odd DIV $77,pliar,2
GET $78,rR
GO $127,$127,0
% Main is the entry point of the program
Main SET pliar,A % initialize registers for calculation
SET pliand,B
SET acc,0
1H GO $127,odd
BZ $78,2F % if pliar is even skip incr. acc with pliand
ADD acc,acc,pliand %
2H GO $127,halve % halve pliar
GO $127,double % and double pliand
PBNZ pliar,1B % repeat from 1H while pliar > 0
// result: acc = 17 x 34
// next: print result --> stdout
// $0 is a temp register
LDA str,BUF+19 % points after the end of the string
2H SUB str,str,1 % update buffer pointer
DIV acc,acc,10 % do a divide and mod
GET $0,rR % get digit from special purpose reg. rR
% containing the remainder of the division
INCL $0,'0' % convert to ascii
STBU $0,str % place digit in buffer
PBNZ acc,2B % next
% 'str' points to the start of the result
TRAP 0,Fputs,StdOut % output answer to stdout
TRAP 0,Halt,0 % exit
Assembling:
~/MIX/MMIX/Progs> mmixal ethiopianmult.mms
Running:
~/MIX/MMIX/Progs> mmix ethiopianmult 578
Modula-2
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 A 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 NOT(IsEven(X)) THEN
INC(Tot, Y);
WriteCard(Y, 9)
END;
WriteLn;
Halve(X);
Double(Y);
END;
WriteString("= ");
WriteCard(Tot, 9);
WriteLn;
END EthiopianMultiplication.
- Output:
17 34 8 4 2 1 544 = 578
Modula-3
MODULE Ethiopian EXPORTS Main;
IMPORT IO, Fmt;
PROCEDURE IsEven(n: INTEGER): BOOLEAN =
BEGIN
RETURN n MOD 2 = 0;
END IsEven;
PROCEDURE Double(n: INTEGER): INTEGER =
BEGIN
RETURN n * 2;
END Double;
PROCEDURE Half(n: INTEGER): INTEGER =
BEGIN
RETURN n DIV 2;
END Half;
PROCEDURE Multiply(a, b: INTEGER): INTEGER =
VAR
temp := 0;
plier := a;
plicand := b;
BEGIN
WHILE plier >= 1 DO
IF NOT IsEven(plier) THEN
temp := temp + plicand;
END;
plier := Half(plier);
plicand := Double(plicand);
END;
RETURN temp;
END Multiply;
BEGIN
IO.Put("17 times 34 = " & Fmt.Int(Multiply(17, 34)) & "\n");
END Ethiopian.
MUMPS
HALVE(I)
;I should be an integer
QUIT I\2
DOUBLE(I)
;I should be an integer
QUIT I*2
ISEVEN(I)
;I should be an integer
QUIT '(I#2)
E2(M,N)
New W,A,E,L Set W=$Select($Length(M)>=$Length(N):$Length(M)+2,1:$L(N)+2),A=0,L=0,A(L,1)=M,A(L,2)=N
Write "Multiplying two numbers:"
For Write !,$Justify(A(L,1),W),?W,$Justify(A(L,2),W) Write:$$ISEVEN(A(L,1)) ?(2*W)," Struck" Set:'$$ISEVEN(A(L,1)) A=A+A(L,2) Set L=L+1,A(L,1)=$$HALVE(A(L-1,1)),A(L,2)=$$DOUBLE(A(L-1,2)) Quit:A(L,1)<1
Write ! For E=W:1:(2*W) Write ?E,"="
Write !,?W,$Justify(A,W),!
Kill W,A,E,L
Q
- Output:
USER>D E2^ROSETTA(1439,7) Multiplying two numbers: 1439 7 719 14 359 28 179 56 89 112 44 224 Struck 22 448 Struck 11 896 5 1792 2 3584 Struck 1 7168 ======= 10073
Nemerle
using System;
using System.Console;
module Ethiopian
{
Multiply(x : int, y : int) : int
{
def halve(a) {a / 2}
def doble(a) {a * 2}
def isEven(a) {a % 2 == 0}
def multiply(p, q)
{
match(p)
{
|p when (p < 1) => 0
|p when (isEven(p)) => 0 + multiply(halve(p), doble(q))
|_ => q + multiply(halve(p), doble(q))
}
}
multiply(x, y)
}
Main() : void
{
WriteLine("By Ethiopian multiplication, 17 * 34 = {0}", Multiply(17, 34));
}
}
NetRexx
/* NetRexx */
options replace format comments java crossref savelog symbols nobinary
/*REXX program multiplies 2 integers by Ethiopian/Russian peasant method*/
numeric digits 1000 /*handle extremely large integers. */
/*handles zeroes and negative integers.*/
/*A & B should be checked if integers.*/
parse arg a b .
say 'a=' a
say 'b=' b
say 'product=' emult(a,b)
return
method emult(x,y) private static
parse x x 1 ox
prod=0
loop while x\==0
if \iseven(x) then prod=prod+y
x=halve(x)
y=dubble(y)
end
return prod*ox.sign
method halve(x) private static
return x % 2
method dubble(x) private static
return x + x
method iseven(x) private static
return x//2 == 0
Nim
proc halve(x: int): int = x div 2
proc double(x: int): int = x * 2
proc odd(x: int): bool = x mod 2 != 0
proc ethiopian(x, y: int): int =
var x = x
var y = y
while x >= 1:
if odd(x):
result += y
x = halve x
y = double y
echo ethiopian(17, 34)
- Output:
578
Objeck
use Collection;
class EthiopianMultiplication {
function : Main(args : String[]) ~ Nil {
first := IO.Console->ReadString()->ToInt();
second := IO.Console->ReadString()->ToInt();
"----"->PrintLine();
Mul(first, second)->PrintLine();
}
function : native : Mul(first : Int, second : Int) ~ Int {
if(first < 0){
first := -1 * first;
second := -1 * second;
};
sum := isEven(first)? 0 : second;
do {
first := halveInt(first);
second := doubleInt(second);
if(isEven(first) = false){
sum += second;
};
}
while(first > 1);
return sum;
}
function : halveInt(num : Int) ~ Bool {
return num >> 1;
}
function : doubleInt(num : Int) ~ Bool {
return num << 1;
}
function : isEven(num : Int) ~ Bool {
return (num and 1) = 0;
}
}
Object Pascal
multiplication.pas:
unit Multiplication;
interface
function Double(Number: Integer): Integer;
function Halve(Number: Integer): Integer;
function Even(Number: Integer): Boolean;
function Ethiopian(NumberA, NumberB: Integer): Integer;
implementation
function Double(Number: Integer): Integer;
begin
result := Number * 2
end;
function Halve(Number: Integer): Integer;
begin
result := Number div 2
end;
function Even(Number: Integer): Boolean;
begin
result := Number mod 2 = 0
end;
function Ethiopian(NumberA, NumberB: Integer): Integer;
begin
result := 0;
while NumberA >= 1 do
begin
if not Even(NumberA) then
result := result + NumberB;
NumberA := Halve(NumberA);
NumberB := Double(NumberB)
end
end;
begin
end.
ethiopianmultiplication.pas:
program EthiopianMultiplication;
uses
Multiplication;
begin
WriteLn('17 * 34 = ', Ethiopian(17, 34))
end.
- Output:
17 * 34 = 578
Objective-C
Using class methods except for the generic useful function iseven.
#import <stdio.h>
BOOL iseven(int x)
{
return (x&1) == 0;
}
@interface EthiopicMult : NSObject
+ (int)mult: (int)plier by: (int)plicand;
+ (int)halve: (int)a;
+ (int)double: (int)a;
@end
@implementation EthiopicMult
+ (int)mult: (int)plier by: (int)plicand
{
int r = 0;
while(plier >= 1) {
if ( !iseven(plier) ) r += plicand;
plier = [EthiopicMult halve: plier];
plicand = [EthiopicMult double: plicand];
}
return r;
}
+ (int)halve: (int)a
{
return (a>>1);
}
+ (int)double: (int)a
{
return (a<<1);
}
@end
int main()
{
@autoreleasepool {
printf("%d\n", [EthiopicMult mult: 17 by: 34]);
}
return 0;
}
OCaml
(* We optimize a bit by not keeping the intermediate lists, and summing
the right column on-the-fly, like in the C version.
The function takes "halve" and "double" operators and "is_even" predicate as arguments,
but also "is_zero", "zero" and "add". This allows for more general uses of the
ethiopian multiplication. *)
let ethiopian is_zero is_even halve zero double add b a =
let rec g a b r =
if is_zero a
then (r)
else g (halve a) (double b) (if not (is_even a) then (add b r) else (r))
in
g a b zero
;;
let imul =
ethiopian (( = ) 0) (fun x -> x mod 2 = 0) (fun x -> x / 2) 0 (( * ) 2) ( + );;
imul 17 34;;
(* - : int = 578 *)
(* Now, we have implemented the same algorithm as "rapid exponentiation",
merely changing operator names *)
let ipow =
ethiopian (( = ) 0) (fun x -> x mod 2 = 0) (fun x -> x / 2) 1 (fun x -> x*x) ( * )
;;
ipow 2 16;;
(* - : int = 65536 *)
(* still renaming operators, if "halving" is just subtracting one,
and "doubling", adding one, then we get an addition *)
let iadd a b =
ethiopian (( = ) 0) (fun x -> false) (pred) b (function x -> x) (fun x y -> succ y) 0 a
;;
iadd 421 1000;;
(* - : int = 1421 *)
(* One can do much more with "ethiopian multiplication",
since the two "multiplicands" and the result may be of three different types,
as shown by the typing system of ocaml *)
ethiopian;;
- : ('a -> bool) -> (* is_zero *)
('a -> bool) -> (* is_even *)
('a -> 'a) -> (* halve *)
'b -> (* zero *)
('c -> 'c) -> (* double *)
('c -> 'b -> 'b) -> (* add *)
'c -> (* b *)
'a -> (* a *)
'b (* result *)
= <fun>
(* Here zero is the starting value for the accumulator of the sums
of values in the right column in the original algorithm. But the "add"
me do something else, see for example the RosettaCode page on
"Exponentiation operator". *)
Octave
function r = halve(a)
r = floor(a/2);
endfunction
function r = doublit(a)
r = a*2;
endfunction
function r = iseven(a)
r = mod(a,2) == 0;
endfunction
function r = ethiopicmult(plier, plicand, tutor=false)
r = 0;
if (tutor)
printf("ethiopic multiplication of %d and %d\n", plier, plicand);
endif
while(plier >= 1)
if ( iseven(plier) )
if (tutor)
printf("%4d %6d struck\n", plier, plicand);
endif
else
r = r + plicand;
if (tutor)
printf("%4d %6d kept\n", plier, plicand);
endif
endif
plier = halve(plier);
plicand = doublit(plicand);
endwhile
endfunction
disp(ethiopicmult(17, 34, true))
Oforth
Based on Forth version.
isEven is already defined for Integers.
: halve 2 / ;
: double 2 * ;
: ethiopian
dup ifZero: [ nip return ]
over double over halve ethiopian
swap isEven ifTrue: [ nip ] else: [ + ] ;
- Output:
17 34 ethiopian . 578
Ol
(define (ethiopian-multiplication l r)
(let ((even? (lambda (n)
(eq? (mod n 2) 0))))
(let loop ((sum 0) (l l) (r r))
(print "sum: " sum ", l: " l ", r: " r)
(if (eq? l 0)
sum
(loop
(if (even? l) (+ sum r) sum)
(floor (/ l 2)) (* r 2))))))
(print (ethiopian-multiplication 17 34))
- Output:
sum: 0, l: 17, r: 34 sum: 0, l: 8, r: 68 sum: 68, l: 4, r: 136 sum: 204, l: 2, r: 272 sum: 476, l: 1, r: 544 sum: 476, l: 0, r: 1088 476
ooRexx
The Rexx solution shown herein applies equally to ooRexx.
Oz
declare
fun {Halve X} X div 2 end
fun {Double X} X * 2 end
fun {Even X} {Abs X mod 2} == 0 end %% standard function: Int.isEven
fun {EthiopicMult X Y}
X >= 0 = true %% assert: X must not be negative
Rows = for
L in X; L>0; {Halve L} %% C-like iterator: "Init; While; Next"
R in Y; true; {Double R}
collect:Collect
do
{Collect L#R}
end
OddRows = {Filter Rows LeftIsOdd}
RightColumn = {Map OddRows SelectRight}
in
{Sum RightColumn}
end
%% Helpers
fun {LeftIsOdd L#_} {Not {Even L}} end
fun {SelectRight _#R} R end
fun {Sum Xs} {FoldL Xs Number.'+' 0} end
in
{Show {EthiopicMult 17 34}}
PARI/GP
halve(n)=n\2;
double(n)=2*n;
even(n)=!(n%2);
multE(a,b)={ my(d=0);
while(a,
if(!even(a),
d+=b);
a=halve(a);
b=double(b));
d
};
Pascal
program EthiopianMultiplication;
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
function Double(Number: Integer): Integer;
begin
Result := Number * 2
end;
function Halve(Number: Integer): Integer;
begin
Result := Number div 2
end;
function Even(Number: Integer): Boolean;
begin
Result := Number mod 2 = 0
end;
function Ethiopian(NumberA, NumberB: Integer): Integer;
begin
Result := 0;
while NumberA >= 1 do
begin
if not Even(NumberA) then
Result := Result + NumberB;
NumberA := Halve(NumberA);
NumberB := Double(NumberB)
end
end;
begin
Write(Ethiopian(17, 34))
end.
PascalABC.NET
function halve(x: integer): integer := x div 2;
function double(x: integer): integer := x * 2;
function odd(x: integer): boolean := x mod 2 <> 0;
function ethiopian(x, y: integer): integer;
begin
while x >= 1 do
begin
if odd(x) then result += y;
x := halve(x);
y := double(y);
end;
end;
begin
ethiopian(17, 34).println;
end.
Perl
use strict;
sub halve { int((shift) / 2); }
sub double { (shift) * 2; }
sub iseven { ((shift) & 1) == 0; }
sub ethiopicmult
{
my ($plier, $plicand, $tutor) = @_;
print "ethiopic multiplication of $plier and $plicand\n" if $tutor;
my $r = 0;
while ($plier >= 1)
{
$r += $plicand unless iseven($plier);
if ($tutor) {
print "$plier, $plicand ", (iseven($plier) ? " struck" : " kept"), "\n";
}
$plier = halve($plier);
$plicand = double($plicand);
}
return $r;
}
print ethiopicmult(17,34, 1), "\n";
Phix
function emHalf(integer n) return floor(n/2) end function function emDouble(integer n) return n*2 end function function emIsEven(integer n) return (remainder(n,2)=0) end function function emMultiply(integer a, integer b) integer sum = 0 while a!=0 do if not emIsEven(a) then sum += b end if a = emHalf(a) b = emDouble(b) end while return sum end function printf(1,"emMultiply(%d,%d) = %d\n",{17,34,emMultiply(17,34)})
PHP
Not object oriented version:
<?php
function halve($x)
{
return floor($x/2);
}
function double($x)
{
return $x*2;
}
function iseven($x)
{
return !($x & 0x1);
}
function ethiopicmult($plier, $plicand, $tutor)
{
if ($tutor) echo "ethiopic multiplication of $plier and $plicand\n";
$r = 0;
while($plier >= 1) {
if ( !iseven($plier) ) $r += $plicand;
if ($tutor)
echo "$plier, $plicand ", (iseven($plier) ? "struck" : "kept"), "\n";
$plier = halve($plier);
$plicand = double($plicand);
}
return $r;
}
echo ethiopicmult(17, 34, true), "\n";
?>
- Output:
ethiopic multiplication of 17 and 34 17, 34 kept 8, 68 struck 4, 136 struck 2, 272 struck 1, 544 kept 578
Object Oriented version:
<?php
class ethiopian_multiply {
protected $result = 0;
protected function __construct($x, $y){
while($x >= 1){
$this->sum_result($x, $y);
$x = $this->half_num($x);
$y = $this->double_num($y);
}
}
protected function half_num($x){
return floor($x/2);
}
protected function double_num($y){
return $y*2;
}
protected function not_even($n){
return $n%2 != 0 ? true : false;
}
protected function sum_result($x, $y){
if($this->not_even($x)){
$this->result += $y;
}
}
protected function get_result(){
return $this->result;
}
static public function init($x, $y){
$init = new ethiopian_multiply($x, $y);
return $init->get_result();
}
}
echo ethiopian_multiply::init(17, 34);
?>
Picat
Iterative
ethiopian(Multiplier, Multiplicand) = ethiopian(Multiplier, Multiplicand,false).
ethiopian(Multiplier, Multiplicand,Tutor) = Result =>
if Tutor then
printf("\n%d * %d:\n",Multiplier, Multiplicand)
end,
Result1 = 0,
while (Multiplier >= 1)
OldResult = Result1,
if not even(Multiplier) then
Result1 := Result1 + Multiplicand
end,
if Tutor then
printf("%6d % 8s\n",Multiplier,cond(OldResult=Result1,"--",Multiplicand.to_string()))
end,
Multiplier := halve(Multiplier),
Multiplicand := double(Multiplicand)
end,
if Tutor then
println(" ======="),
printf(" %8s\n",Result1.to_string()),
nl
end,
Result = Result1.
Recursion
ethiopian2(First,Second,Product) =>
ethiopian2(First,Second,0,Product).
ethiopian2(1,Second,Sum0,Sum) =>
Sum = Sum0 + Second.
ethiopian2(First,Second,Sum0,Sum) =>
Sum1 = Sum0 + Second*(First mod 2),
ethiopian2(halve(First), double(Second), Sum1, Sum).
halve(X) = X div 2.
double(X) = 2*X.
is_even(X) => X mod 2 = 0.
Test
go =>
println(ethiopian(17,34)),
ethiopian2(17,34,Z2),
println(Z2),
println(ethiopian(17,34,true)),
_ = random2(),
_ = ethiopian(random() mod 10000,random() mod 10000,true),
nl.
- Output:
578 578 17 * 34: 17 34 8 -- 4 -- 2 -- 1 544 ======= 578 578 5516 * 9839: 5516 -- 2758 -- 1379 39356 689 78712 344 -- 172 -- 86 -- 43 1259392 21 2518784 10 -- 5 10075136 2 -- 1 40300544 ======= 54271924
PicoLisp
(de halve (N)
(/ N 2) )
(de double (N)
(* N 2) )
(de even? (N)
(not (bit? 1 N)) )
(de ethiopian (X Y)
(let R 0
(while (>= X 1)
(or (even? X) (inc 'R Y))
(setq
X (halve X)
Y (double Y) ) )
R ) )
Pike
int ethopian_multiply(int l, int r)
{
int halve(int n) { return n/2; };
int double(int n) { return n*2; };
int(0..1) evenp(int n) { return !(n%2); };
int product = 0;
do
{
write("%5d %5d\n", l, r);
if (!evenp(l))
product += r;
l = halve(l);
r = double(r);
}
while(l);
return product;
}
PL/I
declare (L(30), R(30)) fixed binary;
declare (i, s) fixed binary;
L, R = 0;
put skip list
('Hello, please type two values and I will print their product:');
get list (L(1), R(1));
put edit ('The product of ', trim(L(1)), ' and ', trim(R(1)), ' is ') (a);
do i = 1 by 1 while (L(i) ^= 0);
L(i+1) = halve(L(i));
R(i+1) = double(R(i));
end;
s = 0;
do i = 1 by 1 while (L(i) > 0);
if odd(L(i)) then s = s + R(i);
end;
put edit (trim(s)) (a);
halve: procedure (k) returns (fixed binary);
declare k fixed binary;
return (k/2);
end halve;
double: procedure (k) returns (fixed binary);
declare k fixed binary;
return (2*k);
end;
odd: procedure (k) returns (bit (1));
return (iand(k, 1) ^= 0);
end odd;
PL/M
... under CP/M (or an emulator)
100H: /* ETHIOPIAN MULTIPLICATION */
/* CP/M SYSTEM CALL AND I/O ROUTINES */
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
PR$NL: PROCEDURE; CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END;
PR$NUMBER: PROCEDURE( N ); /* PRINTS A NUMBER IN THE MINIMUN FIELD WIDTH */
DECLARE N ADDRESS;
DECLARE V ADDRESS, N$STR ( 6 )BYTE, W BYTE;
V = N;
W = LAST( N$STR );
N$STR( W ) = '$';
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
DO WHILE( ( V := V / 10 ) > 0 );
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
END;
CALL PR$STRING( .N$STR( W ) );
END PR$NUMBER;
/* RETURNS THE RESULT OF A * B USING ETHOPIAN MULTIPLICATION */
ETHIOPIAN$MULTIPLICATION: PROCEDURE( A, B )ADDRESS;
DECLARE ( A, B ) ADDRESS;
DECLARE RES ADDRESS;
CALL PR$STRING( .'ETHIOPIAN MULTIPLICATION OF $' );
CALL PR$NUMBER( A );
CALL PR$STRING( .' BY $' );
CALL PR$NUMBER( B );
CALL PR$NL;
RES = 0;
DO WHILE A >= 1;
CALL PR$NUMBER( A );
CALL PR$CHAR( ' ' );
CALL PR$NUMBER( B );
IF A MOD 2 = 0 THEN DO;
CALL PR$STRING( .' STRIKE$' );
END;
ELSE DO;
CALL PR$STRING( .' KEEP$' );
RES = RES + B;
END;
CALL PR$NL;
A = SHR( A, 1 );
B = SHL( B, 1 );
END;
RETURN( RES );
END ETHIOPIAN$MULTIPLICATION;
DECLARE RES ADDRESS;
RES = ETHIOPIAN$MULTIPLICATION( 17, 34 );
CALL PR$STRING( .'RESULT IS $' );
CALL PR$NUMBER( RES );
EOF
- Output:
ETHIOPIAN MULTIPLICATION OF 17 BY 34 17 34 KEEP 8 68 STRIKE 4 136 STRIKE 2 272 STRIKE 1 544 KEEP RESULT IS 578
PL/SQL
This code was taken from the ADA example above - very minor differences.
create or replace package ethiopian is
function multiply
( left in integer,
right in integer)
return integer;
end ethiopian;
/
create or replace package body ethiopian is
function is_even(item in integer) return boolean is
begin
return item mod 2 = 0;
end is_even;
function double(item in integer) return integer is
begin
return item * 2;
end double;
function half(item in integer) return integer is
begin
return trunc(item / 2);
end half;
function multiply
( left in integer,
right in integer)
return Integer
is
temp integer := 0;
plier integer := left;
plicand integer := right;
begin
loop
if not is_even(plier) then
temp := temp + plicand;
end if;
exit when plier <= 1;
plier := half(plier);
plicand := double(plicand);
end loop;
return temp;
end multiply;
end ethiopian;
/
/* example call */
begin
dbms_output.put_line(ethiopian.multiply(17, 34));
end;
/
Plain English
\All required helper routines already exist in Plain English:
\
\To cut a number in half:
\Divide the number by 2.
\
\To double a number:
\Add the number to the number.
\
\To decide if a number is odd:
\Privatize the number.
\Bitwise and the number with 1.
\If the number is 0, say no.
\Say yes.
To run:
Start up.
Put 17 into a number.
Multiply the number by 34 (Ethiopian).
Convert the number to a string.
Write the string to the console.
Wait for the escape key.
Shut down.
To multiply a number by another number (Ethiopian):
Put 0 into a sum number.
Loop.
If the number is 0, break.
If the number is odd, add the other number to the sum.
Cut the number in half.
Double the other number.
Repeat.
Put the sum into the number.
- Output:
578
Powerbuilder
public function boolean wf_iseven (long al_arg);return mod(al_arg, 2 ) = 0
end function
public function long wf_halve (long al_arg);RETURN int(al_arg / 2)
end function
public function long wf_double (long al_arg);RETURN al_arg * 2
end function
public function long wf_ethiopianmultiplication (long al_multiplicand, long al_multiplier);// calculate result
long ll_product
DO WHILE al_multiplicand >= 1
IF wf_iseven(al_multiplicand) THEN
// do nothing
ELSE
ll_product += al_multiplier
END IF
al_multiplicand = wf_halve(al_multiplicand)
al_multiplier = wf_double(al_multiplier)
LOOP
return ll_product
end function
// example call
long ll_answer
ll_answer = wf_ethiopianmultiplication(17,34)
PowerShell
Traditional
function isEven {
param ([int]$value)
return [bool]($value % 2 -eq 0)
}
function doubleValue {
param ([int]$value)
return [int]($value * 2)
}
function halveValue {
param ([int]$value)
return [int]($value / 2)
}
function multiplyValues {
param (
[int]$plier,
[int]$plicand,
[int]$temp = 0
)
while ($plier -ge 1)
{
if (!(isEven $plier)) {
$temp += $plicand
}
$plier = halveValue $plier
$plicand = doubleValue $plicand
}
return $temp
}
multiplyValues 17 34
Pipes with Busywork
This uses several PowerShell specific features, in functions everything is returned automatically, so explicitly stating return is unnecessary. type conversion happens automatically for certain types, [int] into [boolean] maps 0 to false and everything else to true. A hash is used to store the values as they are being written, then a pipeline is used to iterate over the keys of the hash, determine which are odd, and only sum those. The three-valued ForEach-Object is used to set a start expression, an iterative expression, and a return expression.
function halveInt( [int] $rhs )
{
[math]::floor( $rhs / 2 )
}
function doubleInt( [int] $rhs )
{
$rhs*2
}
function isEven( [int] $rhs )
{
-not ( $_ % 2 )
}
function Ethiopian( [int] $lhs , [int] $rhs )
{
$scratch = @{}
1..[math]::floor( [math]::log( $lhs , 2 ) + 1 ) |
ForEach-Object {
$scratch[$lhs] = $rhs
$lhs
$lhs = halveInt( $lhs )
$rhs = doubleInt( $rhs ) } |
Where-Object { -not ( isEven $_ ) } |
ForEach-Object { $sum = 0 } { $sum += $scratch[$_] } { $sum }
}
Ethiopian 17 34
Prolog
Traditional
halve(X,Y) :- Y is X // 2.
double(X,Y) :- Y is 2*X.
is_even(X) :- 0 is X mod 2.
% columns(First,Second,Left,Right) is true if integers First and Second
% expand into the columns Left and Right, respectively
columns(1,Second,[1],[Second]).
columns(First,Second,[First|Left],[Second|Right]) :-
halve(First,Halved),
double(Second,Doubled),
columns(Halved,Doubled,Left,Right).
% contribution(Left,Right,Amount) is true if integers Left and Right,
% from their respective columns contribute Amount to the final sum.
contribution(Left,_Right,0) :-
is_even(Left).
contribution(Left,Right,Right) :-
\+ is_even(Left).
ethiopian(First,Second,Product) :-
columns(First,Second,Left,Right),
maplist(contribution,Left,Right,Contributions),
sumlist(Contributions,Product).
Functional Style
Using the same definitions as above for "halve/2", "double/2" and "is_even/2" along with an SWI-Prolog pack for function notation, one might write the following solution
:- use_module(library(func)).
% halve/2, double/2, is_even/2 definitions go here
ethiopian(First,Second,Product) :-
ethiopian(First,Second,0,Product).
ethiopian(1,Second,Sum0,Sum) :-
Sum is Sum0 + Second.
ethiopian(First,Second,Sum0,Sum) :-
Sum1 is Sum0 + Second*(First mod 2),
ethiopian(halve $ First, double $ Second, Sum1, Sum).
Constraint Handling Rules
This is a CHR solution for this problem using Prolog as the host language. Code will work in SWI-Prolog and YAP (and possibly in others with or without some minor tweaking).
:- module(ethiopia, [test/0, mul/3]).
:- use_module(library(chr)).
:- chr_constraint mul/3, halve/2, double/2, even/1, add_odd/4.
mul(1, Y, S) <=> S = Y.
mul(X, Y, S) <=> X \= 1 | halve(X, X1),
double(Y, Y1),
mul(X1, Y1, S1),
add_odd(X, Y, S1, S).
halve(X, Y) <=> Y is X // 2.
double(X, Y) <=> Y is X * 2.
even(X) <=> 0 is X mod 2 | true.
even(X) <=> 1 is X mod 2 | false.
add_odd(X, _, A, S) <=> even(X) | S is A.
add_odd(X, Y, A, S) <=> \+ even(X) | S is A + Y.
test :-
mul(17, 34, Z), !,
writeln(Z).
Note that the task statement is what makes the halve and double constraints required. Their use is highly artificial and a more realistic implementation would look like this:
:- module(ethiopia, [test/0, mul/3]).
:- use_module(library(chr)).
:- chr_constraint mul/3, even/1, add_if_odd/4.
mul(1, Y, S) <=> S = Y.
mul(X, Y, S) <=> X \= 1 | X1 is X // 2,
Y1 is Y * 2,
mul(X1, Y1, S1),
add_if_odd(X, Y, S1, S).
even(X) <=> 0 is X mod 2 | true.
even(X) <=> 1 is X mod 2 | false.
add_if_odd(X, _, A, S) <=> even(X) | S is A.
add_if_odd(X, Y, A, S) <=> \+ even(X) | S is A + Y.
test :-
mul(17, 34, Z),
writeln(Z).
Even this is more verbose than what a more native solution would look like.
Python
Python: With tutor
tutor = True
def halve(x):
return x // 2
def double(x):
return x * 2
def even(x):
return not x % 2
def ethiopian(multiplier, multiplicand):
if tutor:
print("Ethiopian multiplication of %i and %i" %
(multiplier, multiplicand))
result = 0
while multiplier >= 1:
if even(multiplier):
if tutor:
print("%4i %6i STRUCK" %
(multiplier, multiplicand))
else:
if tutor:
print("%4i %6i KEPT" %
(multiplier, multiplicand))
result += multiplicand
multiplier = halve(multiplier)
multiplicand = double(multiplicand)
if tutor:
print()
return result
Sample output
Python 3.1 (r31:73574, Jun 26 2009, 20:21:35) [MSC v.1500 32 bit (Intel)] on win32 Type "copyright", "credits" or "license()" for more information. >>> ethiopian(17, 34) Ethiopian multiplication of 17 and 34 17 34 KEPT 8 68 STRUCK 4 136 STRUCK 2 272 STRUCK 1 544 KEPT 578 >>>
Python: Without tutor
Without the tutorial code, and taking advantage of Python's lambda:
halve = lambda x: x // 2
double = lambda x: x*2
even = lambda x: not x % 2
def ethiopian(multiplier, multiplicand):
result = 0
while multiplier >= 1:
if not even(multiplier):
result += multiplicand
multiplier = halve(multiplier)
multiplicand = double(multiplicand)
return result
Python: With tutor. More Functional
Using some features which Python has for use in functional programming. The example also tries to show how to mix different programming styles while keeping close to the task specification, a kind of "executable pseudocode". Note: While column2 could theoretically generate a sequence of infinite length, izip will stop requesting values from it (and so provide the necessary stop condition) when column1 has no more values. When not using the tutor, table will generate the table on the fly in an efficient way, not keeping any intermediate values.
tutor = True
from itertools import izip, takewhile
def iterate(function, arg):
while 1:
yield arg
arg = function(arg)
def halve(x): return x // 2
def double(x): return x * 2
def even(x): return x % 2 == 0
def show_heading(multiplier, multiplicand):
print "Multiplying %d by %d" % (multiplier, multiplicand),
print "using Ethiopian multiplication:"
print
TABLE_FORMAT = "%8s %8s %8s %8s %8s"
def show_table(table):
for p, q in table:
print TABLE_FORMAT % (p, q, "->",
p, q if not even(p) else "-" * len(str(q)))
def show_result(result):
print TABLE_FORMAT % ('', '', '', '', "=" * (len(str(result)) + 1))
print TABLE_FORMAT % ('', '', '', '', result)
def ethiopian(multiplier, multiplicand):
def column1(x): return takewhile(lambda v: v >= 1, iterate(halve, x))
def column2(x): return iterate(double, x)
def rows(x, y): return izip(column1(x), column2(y))
table = rows(multiplier, multiplicand)
if tutor:
table = list(table)
show_heading(multiplier, multiplicand)
show_table(table)
result = sum(q for p, q in table if not even(p))
if tutor:
show_result(result)
return result
- Example output:
>>> ethiopian(17, 34) Multiplying 17 by 34 using Ethiopian multiplication:
17 34 -> 17 34 8 68 -> 8 -- 4 136 -> 4 --- 2 272 -> 2 --- 1 544 -> 1 544 ==== 578 578
Python: as an unfold followed by a fold
Avoiding the use of the multiplication operator, and defining a catamorphism applied over an anamorphism.
'''Ethiopian multiplication'''
from functools import reduce
# ethMult :: Int -> Int -> Int
def ethMult(n):
'''Ethiopian multiplication of n by m.'''
def doubled(x):
return x + x
def halved(h):
qr = divmod(h, 2)
if 0 < h:
print('halve:', str(qr).rjust(8, ' '))
return qr if 0 < h else None
def addedWhereOdd(a, remx):
odd, x = remx
if odd:
print(
str(a).rjust(2, ' '), '+',
str(x).rjust(3, ' '), '->',
str(a + x).rjust(3, ' ')
)
return a + x
else:
print(str(x).rjust(8, ' '))
return a
return lambda m: reduce(
addedWhereOdd,
zip(
unfoldr(halved)(n),
iterate(doubled)(m)
),
0
)
# ------------------------- TEST -------------------------
def main():
'''Tests of multiplication.'''
print(
'\nProduct: ' + str(
ethMult(17)(34)
),
'\n_______________\n'
)
print(
'\nProduct: ' + str(
ethMult(34)(17)
)
)
# ----------------------- GENERIC ------------------------
# iterate :: (a -> a) -> a -> Gen [a]
def iterate(f):
'''An infinite list of repeated
applications of f to x.
'''
def go(x):
v = x
while True:
yield v
v = f(v)
return go
# showLog :: a -> IO String
def showLog(*s):
'''Arguments printed with
intercalated arrows.'''
print(
' -> '.join(map(str, s))
)
# unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
def unfoldr(f):
'''Dual to reduce or foldr.
Where catamorphism reduces a list to a summary value,
the anamorphic unfoldr builds a list from a seed value.
As long as f returns Just(a, b), a is prepended to the list,
and the residual b is used as the argument for the next
application of f.
When f returns Nothing, the completed list is returned.'''
def go(v):
xr = v, v
xs = []
while True:
xr = f(xr[0])
if xr:
xs.append(xr[1])
else:
return xs
return xs
return go
# MAIN ---
if __name__ == '__main__':
main()
- Output:
halve: (8, 1) halve: (4, 0) halve: (2, 0) halve: (1, 0) halve: (0, 1) 0 + 34 -> 34 68 136 272 34 + 544 -> 578 Product: 578 _______________ halve: (17, 0) halve: (8, 1) halve: (4, 0) halve: (2, 0) halve: (1, 0) halve: (0, 1) 17 0 + 34 -> 34 68 136 272 34 + 544 -> 578 Product: 578
Quackery
Extended to handle negative numbers.
[ 1 & not ] is even ( n --> b )
[ 1 << ] is double ( n --> n )
[ 1 >> ] is halve ( n --> n )
[ dup 0 < unrot abs
[ dup 0 = iff nip done
over double over halve
recurse
swap even
iff nip else + ]
swap if negate ] is e* ( n n --> n )
R
R: With tutor
halve <- function(a) floor(a/2)
double <- function(a) a*2
iseven <- function(a) (a%%2)==0
ethiopicmult <- function(plier, plicand, tutor=FALSE) {
if (tutor) { cat("ethiopic multiplication of", plier, "and", plicand, "\n") }
result <- 0
while(plier >= 1) {
if (!iseven(plier)) { result <- result + plicand }
if (tutor) {
cat(plier, ", ", plicand, " ", ifelse(iseven(plier), "struck", "kept"), "\n", sep="")
}
plier <- halve(plier)
plicand <- double(plicand)
}
result
}
print(ethiopicmult(17, 34, TRUE))
R: Without tutor
Simplified version.
halve <- function(a) floor(a/2)
double <- function(a) a*2
iseven <- function(a) (a%%2)==0
ethiopicmult<-function(x,y){
res<-ifelse(iseven(y),0,x)
while(!y==1){
x<-double(x)
y<-halve(y)
if(!iseven(y)) res<-res+x
}
return(res)
}
print(ethiopicmult(17,34))
Racket
#lang racket
(define (halve i) (quotient i 2))
(define (double i) (* i 2))
;; `even?' is built-in
(define (ethiopian-multiply x y)
(cond [(zero? x) 0]
[(even? x) (ethiopian-multiply (halve x) (double y))]
[else (+ y (ethiopian-multiply (halve x) (double y)))]))
(ethiopian-multiply 17 34) ; -> 578
Raku
(formerly Perl 6)
sub halve (Int $n is rw) { $n div= 2 }
sub double (Int $n is rw) { $n *= 2 }
sub even (Int $n --> Bool) { $n %% 2 }
sub ethiopic-mult (Int $a is copy, Int $b is copy --> Int) {
my Int $r = 0;
while $a {
even $a or $r += $b;
halve $a;
double $b;
}
return $r;
}
say ethiopic-mult(17,34);
- Output:
578
More succinctly using implicit typing, primed lambdas, and an infinite loop:
sub ethiopic-mult {
my &halve = * div= 2;
my &double = * *= 2;
my &even = * %% 2;
my ($a,$b) = @_;
my $r;
loop {
even $a or $r += $b;
halve $a or return $r;
double $b;
}
}
say ethiopic-mult(17,34);
More succinctly still, using a pure functional approach (reductions, mappings, lazy infinite sequences):
sub halve { $^n div 2 }
sub double { $^n * 2 }
sub even { $^n %% 2 }
sub ethiopic-mult ($a, $b) {
[+] ($b, &double ... *)
Z*
($a, &halve ... 0).map: { not even $^n }
}
say ethiopic-mult(17,34);
(same output)
Rascal
import IO;
public int halve(int n) = n/2;
public int double(int n) = n*2;
public bool uneven(int n) = (n % 2) != 0);
public int ethiopianMul(int n, int m) {
result = 0;
while(n >= 1) {
if(uneven(n))
result += m;
n = halve(n);
m = double(m);
}
return result;
}
Red
Red["Ethiopian multiplication"]
halve: function [n][n >> 1]
double: function [n][n << 1]
;== even? already exists
ethiopian-multiply: function [
"Returns the product of two integers using Ethiopian multiplication"
a [integer!] "The multiplicand"
b [integer!] "The multiplier"
][
result: 0
while [a <> 0][
if odd? a [result: result + b]
a: halve a
b: double b
]
result
]
print ethiopian-multiply 17 34
- Output:
578
Relation
function half(x)
set result = floor(x/2)
end function
function double(x)
set result = 2*x
end function
function even(x)
set result = (x/2 > floor(x/2))
end function
program ethiopian_mul(a,b)
relation first, second
while a >= 1
insert a, b
set a = half(a)
set b = double(b)
end while
extend third = even(first) * second
project third sum
end program
run ethiopian_mul(17,34)
print
REXX
These two REXX versions properly handle negative integers.
sans error checking
/*REXX program multiplies two integers by the Ethiopian (or Russian peasant) method. */
numeric digits 3000 /*handle some gihugeic integers. */
parse arg a b . /*get two numbers from the command line*/
say 'a=' a /*display a formatted value of A. */
say 'b=' b /* " " " " " B. */
say 'product=' eMult(a, b) /*invoke eMult & multiple two integers.*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
eMult: procedure; parse arg x,y; s=sign(x) /*obtain the two arguments; sign for X.*/
$=0 /*product of the two integers (so far).*/
do while x\==0 /*keep processing while X not zero.*/
if \isEven(x) then $=$+y /*if odd, then add Y to product. */
x= halve(x) /*invoke the HALVE function. */
y=double(y) /* " " DOUBLE " */
end /*while*/ /* [↑] Ethiopian multiplication method*/
return $*s/1 /*maintain the correct sign for product*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
double: return arg(1) * 2 /* * is REXX's multiplication. */
halve: return arg(1) % 2 /* % " " integer division. */
isEven: return arg(1) // 2 == 0 /* // " " division remainder.*/
output when the following input is used: 30 -7
a= 30 b= -7 product= -210
with error checking
This REXX version also aligns the "input" messages and also performs some basic error checking.
Note that the 2nd number needn't be an integer, any valid number will work.
/*REXX program multiplies two integers by the Ethiopian (or Russian peasant) method. */
numeric digits 3000 /*handle some gihugeic integers. */
parse arg a b _ . /*get two numbers from the command line*/
if a=='' then call error "1st argument wasn't specified."
if b=='' then call error "2nd argument wasn't specified."
if _\=='' then call error "too many arguments were specified: " _
if \datatype(a, 'W') then call error "1st argument isn't an integer: " a
if \datatype(b, 'N') then call error "2nd argument isn't a valid number: " b
p=eMult(a, b) /*Ethiopian or Russian peasant method. */
w=max(length(a), length(b), length(p)) /*find the maximum width of 3 numbers. */
say ' a=' right(a, w) /*use right justification to display A.*/
say ' b=' right(b, w) /* " " " " " B.*/
say 'product=' right(p, w) /* " " " " " P.*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
eMult: procedure; parse arg x,y; s=sign(x) /*obtain the two arguments; sign for X.*/
$=0 /*product of the two integers (so far).*/
do while x\==0 /*keep processing while X not zero.*/
if \isEven(x) then $=$+y /*if odd, then add Y to product. */
x= halve(x) /*invoke the HALVE function. */
y=double(y) /* " " DOUBLE " */
end /*while*/ /* [↑] Ethiopian multiplication method*/
return $*s/1 /*maintain the correct sign for product*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
double: return arg(1) * 2 /* * is REXX's multiplication. */
halve: return arg(1) % 2 /* % " " integer division. */
isEven: return arg(1) // 2 == 0 /* // " " division remainder.*/
error: say '***error!***' arg(1); exit 13 /*display an error message to terminal.*/
output when the following input is used: 200 0.333
a= 200 b= 0.333 product= 66.6
Ring
x = 17
y = 34
p = 0
while x != 0
if not even(x)
p += y
see "" + x + " " + " " + y + nl
else
see "" + x + " ---" + nl ok
x = halve(x)
y = double(y)
end
see " " + " ===" + nl
see " " + p
func double n return (n * 2)
func halve n return floor(n / 2)
func even n return ((n & 1) = 0)
Output:
17 34 8 --- 4 --- 2 --- 1 544 === 578
RPL
Calculations are here made on binary integers, on which built-in instructions SL
and SR
perform resp. doubling and halving.
RPL code | Comment |
---|---|
≪ # 1d AND # 0d == ≫ 'EVEN?' STO ≪ # 0d ROT R→B ROT R→B WHILE OVER # 0d ≠ REPEAT IF OVER EVEN? NOT THEN ROT OVER + ROT ROT END SL SWAP SR SWAP END DROP2 B→R ≫ 'ETMUL' STO |
EVEN? ( #n -- boolean ) return 1 if n is even, 0 otherwise ETMUL ( a b -- a*b ) put accumulator, a and b (converted to integers) in stack while b > 0 if b is odd add a to accumulator double a, halve b delete a and b and convert a*b to floating point |
Ruby
Iterative and recursive implementations here. I've chosen to highlight the example 20*5 which I think is more illustrative.
def halve(x) = x/2
def double(x) = x*2
# iterative
def ethiopian_multiply(a, b)
product = 0
while a >= 1
p [a, b, a.even? ? "STRIKE" : "KEEP"] if $DEBUG
product += b unless a.even?
a = halve(a)
b = double(b)
end
product
end
# recursive
def rec_ethiopian_multiply(a, b)
return 0 if a < 1
p [a, b, a.even? ? "STRIKE" : "KEEP"] if $DEBUG
(a.even? ? 0 : b) + rec_ethiopian_multiply(halve(a), double(b))
end
$DEBUG = true # $DEBUG also set to true if "-d" option given
a, b = 20, 5
puts "#{a} * #{b} = #{ethiopian_multiply(a,b)}"; puts
- Output:
[20, 5, "STRIKE"] [10, 10, "STRIKE"] [5, 20, "KEEP"] [2, 40, "STRIKE"] [1, 80, "KEEP"] 20 * 5 = 100
A test suite:
require 'test/unit'
class EthiopianTests < Test::Unit::TestCase
def test_iter1; assert_equal(578, ethopian_multiply(17,34)); end
def test_iter2; assert_equal(100, ethopian_multiply(20,5)); end
def test_iter3; assert_equal(5, ethopian_multiply(5,1)); end
def test_iter4; assert_equal(5, ethopian_multiply(1,5)); end
def test_iter5; assert_equal(0, ethopian_multiply(5,0)); end
def test_iter6; assert_equal(0, ethopian_multiply(0,5)); end
def test_rec1; assert_equal(578, rec_ethopian_multiply(17,34)); end
def test_rec2; assert_equal(100, rec_ethopian_multiply(20,5)); end
def test_rec3; assert_equal(5, rec_ethopian_multiply(5,1)); end
def test_rec4; assert_equal(5, rec_ethopian_multiply(1,5)); end
def test_rec5; assert_equal(0, rec_ethopian_multiply(5,0)); end
def test_rec6; assert_equal(0, rec_ethopian_multiply(0,5)); end
end
Run options: # Running tests: ............ Finished tests in 0.014001s, 857.0816 tests/s, 857.0816 assertions/s. 12 tests, 12 assertions, 0 failures, 0 errors, 0 skips ruby -v: ruby 2.0.0p247 (2013-06-27) [i386-mingw32]
Rust
fn double(a: i32) -> i32 {
2*a
}
fn halve(a: i32) -> i32 {
a/2
}
fn is_even(a: i32) -> bool {
a % 2 == 0
}
fn ethiopian_multiplication(mut x: i32, mut y: i32) -> i32 {
let mut sum = 0;
while x >= 1 {
print!("{} \t {}", x, y);
match is_even(x) {
true => println!("\t Not Kept"),
false => {
println!("\t Kept");
sum += y;
}
}
x = halve(x);
y = double(y);
}
sum
}
fn main() {
let output = ethiopian_multiplication(17, 34);
println!("---------------------------------");
println!("\t {}", output);
}
- Output:
17 34 Kept 8 68 Not Kept 4 136 Not Kept 2 272 Not Kept 1 544 Kept --------------------------------- 578
S-BASIC
$constant true = 0FFFFH
$constant false = 0
function half(n = integer) = integer
end = n / 2
function twice(n = integer) = integer
end = n + n
rem - return true (-1) if n is even, otherwise false
function even(n = integer) = integer
var one = integer
one = 1 rem - only variables are compared bitwise
end = ((n and one) = 0)
rem - return i * j, optionally showing steps
function ethiopian(i, j, show = integer) = integer
var p = integer
p = 0
while i >= 1 do
begin
if even(i) then
begin
if show then print i;" ---";j
end
else
begin
if show then print i;" ";j;"+"
p = p + j
end
i = half(i)
j = twice(j)
end
if show then
begin
print "----------"
print " =";
end
end = p
rem - exercise the function
print "Multiplying 17 times 34"
print ethiopian(17,34,true)
end
- Output:
Multiplying 17 times 34 17 34+ 8 --- 68 4 --- 136 2 --- 272 1 544+ ---------- = 578
Scala
The first and second are only slightly different and use functional style. The third uses a for loop to yield the result. The fourth uses recursion.
def ethiopian(i:Int, j:Int):Int=
pairIterator(i,j).filter(x=> !isEven(x._1)).map(x=>x._2).foldLeft(0){(x,y)=>x+y}
def ethiopian2(i:Int, j:Int):Int=
pairIterator(i,j).map(x=>if(isEven(x._1)) 0 else x._2).foldLeft(0){(x,y)=>x+y}
def ethiopian3(i:Int, j:Int):Int=
{
var res=0;
for((h,d) <- pairIterator(i,j) if !isEven(h)) res+=d;
res
}
def ethiopian4(i: Int, j: Int): Int = if (i == 1) j else ethiopian(halve(i), double(j)) + (if (isEven(i)) 0 else j)
def isEven(x:Int)=(x&1)==0
def halve(x:Int)=x>>>1
def double(x:Int)=x<<1
// generates pairs of values (halve,double)
def pairIterator(x:Int, y:Int)=new Iterator[(Int, Int)]
{
var i=(x, y)
def hasNext=i._1>0
def next={val r=i; i=(halve(i._1), double(i._2)); r}
}
Scheme
In Scheme, even?
is a standard procedure.
(define (halve num)
(quotient num 2))
(define (double num)
(* num 2))
(define (*mul-eth plier plicand acc)
(cond ((zero? plier) acc)
((even? plier) (*mul-eth (halve plier) (double plicand) acc))
(else (*mul-eth (halve plier) (double plicand) (+ acc plicand)))))
(define (mul-eth plier plicand)
(*mul-eth plier plicand 0))
(display (mul-eth 17 34))
(newline)
Output:
578
Seed7
Ethiopian Multiplication is another name for the peasant multiplication:
const proc: double (inout integer: a) is func
begin
a *:= 2;
end func;
const proc: halve (inout integer: a) is func
begin
a := a div 2;
end func;
const func boolean: even (in integer: a) is
return not odd(a);
const func integer: peasantMult (in var integer: a, in var integer: b) is func
result
var integer: result is 0;
begin
while a <> 0 do
if not even(a) then
result +:= b;
end if;
halve(a);
double(b);
end while;
end func;
Original source (without separate functions for doubling, halving, and checking if a number is even): [2]
Sidef
func double (n) { n << 1 }
func halve (n) { n >> 1 }
func isEven (n) { n&1 == 0 }
func ethiopian_mult(a, b) {
var r = 0
while (a > 0) {
r += b if !isEven(a)
a = halve(a)
b = double(b)
}
return r
}
say ethiopian_mult(17, 34)
- Output:
578
Smalltalk
Number extend [
double [ ^ self * 2 ]
halve [ ^ self // 2 ]
ethiopianMultiplyBy: aNumber withTutor: tutor [
|result multiplier multiplicand|
multiplier := self.
multiplicand := aNumber.
tutor ifTrue: [ ('ethiopian multiplication of %1 and %2' %
{ multiplier. multiplicand }) displayNl ].
result := 0.
[ multiplier >= 1 ]
whileTrue: [
multiplier even ifFalse: [
result := result + multiplicand.
tutor ifTrue: [
('%1, %2 kept' % { multiplier. multiplicand })
displayNl
]
]
ifTrue: [
tutor ifTrue: [
('%1, %2 struck' % { multiplier. multiplicand })
displayNl
]
].
multiplier := multiplier halve.
multiplicand := multiplicand double.
].
^result
]
ethiopianMultiplyBy: aNumber [ ^ self ethiopianMultiplyBy: aNumber withTutor: false ]
].
(17 ethiopianMultiplyBy: 34 withTutor: true) displayNl.
SNOBOL4
define('halve(num)') :(halve_end)
halve eq(num,1) :s(freturn)
halve = num / 2 :(return)
halve_end
define('double(num)') :(double_end)
double double = num * 2 :(return)
double_end
define('odd(num)') :(odd_end)
odd eq(num,1) :s(return)
eq(num,double(halve(num))) :s(freturn)f(return)
odd_end l = trim(input)
r = trim(input)
s = 0
next s = odd(l) s + r
r = double(r)
l = halve(l) :s(next)
stop output = s
end
SNUSP
/==!/==atoi==@@@-@-----#
| | /-\ /recurse\ #/?\ zero
$>,@/>,@/?\<=zero=!\?/<=print==!\@\>?!\@/<@\.!\-/
< @ # | \=/ \=itoa=@@@+@+++++#
/==\ \===?!/===-?\>>+# halve ! /+ !/+ !/+ !/+ \ mod10
# ! @ | #>>\?-<+>/ /<+> -\!?-\!?-\!?-\!?-\!
/-<+>\ > ? />+<<++>-\ \?!\-?!\-?!\-?!\-?!\-?/\ div10
?down? | \-<<<!\=======?/\ add & # +/! +/! +/! +/! +/
\>+<-/ | \=<<<!/====?\=\ | double
! # | \<++>-/ | |
\=======\!@>============/!/
This is possibly the smallest multiply routine so far discovered for SNUSP.
Soar
##########################################
# multiply takes ^left and ^right numbers
# and a ^return-to
sp {multiply*elaborate*initialize
(state <s> ^superstate.operator <o>)
(<o> ^name multiply
^left <x>
^right <y>
^return-to <r>)
-->
(<s> ^name multiply
^left <x>
^right <y>
^return-to <r>)}
sp {multiply*propose*recurse
(state <s> ^name multiply
^left <x> > 0
^right <y>
^return-to <r>
-^multiply-done)
-->
(<s> ^operator <o> +)
(<o> ^name multiply
^left (div <x> 2)
^right (* <y> 2)
^return-to <s>)}
sp {multiply*elaborate*mod
(state <s> ^name multiply
^left <x>)
-->
(<s> ^left-mod-2 (mod <x> 2))}
sp {multiply*elaborate*recursion-done-even
(state <s> ^name multiply
^left <x>
^right <y>
^multiply-done <temp>
^left-mod-2 0)
-->
(<s> ^answer <temp>)}
sp {multiply*elaborate*recursion-done-odd
(state <s> ^name multiply
^left <x>
^right <y>
^multiply-done <temp>
^left-mod-2 1)
-->
(<s> ^answer (+ <temp> <y>))}
sp {multiply*elaborate*zero
(state <s> ^name multiply
^left 0)
-->
(<s> ^answer 0)}
sp {multiply*elaborate*done
(state <s> ^name multiply
^return-to <r>
^answer <a>)
-->
(<r> ^multiply-done <a>)}
Swift
import Darwin
func ethiopian(var #int1:Int, var #int2:Int) -> Int {
var lhs = [int1], rhs = [int2]
func isEven(#n:Int) -> Bool {return n % 2 == 0}
func double(#n:Int) -> Int {return n * 2}
func halve(#n:Int) -> Int {return n / 2}
while int1 != 1 {
lhs.append(halve(n: int1))
rhs.append(double(n: int2))
int1 = halve(n: int1)
int2 = double(n: int2)
}
var returnInt = 0
for (a,b) in zip(lhs, rhs) {
if (!isEven(n: a)) {
returnInt += b
}
}
return returnInt
}
println(ethiopian(int1: 17, int2: 34))
- Output:
578
Tcl
# This is how to declare functions - the mathematical entities - as opposed to procedures
proc function {name arguments body} {
uplevel 1 [list proc tcl::mathfunc::$name $arguments [list expr $body]]
}
function double n {$n * 2}
function halve n {$n / 2}
function even n {($n & 1) == 0}
function mult {a b} {
$a < 1 ? 0 :
even($a) ? [logmult STRUCK] + mult(halve($a), double($b))
: [logmult KEPT] + mult(halve($a), double($b)) + $b
}
# Wrapper to set up the logging
proc ethiopianMultiply {a b {tutor false}} {
if {$tutor} {
set wa [expr {[string length $a]+1}]
set wb [expr {$wa+[string length $b]-1}]
puts stderr "Ethiopian multiplication of $a and $b"
interp alias {} logmult {} apply {{wa wb msg} {
upvar 1 a a b b
puts stderr [format "%*d %*d %s" $wa $a $wb $b $msg]
return 0
}} $wa $wb
} else {
proc logmult args {return 0}
}
return [expr {mult($a,$b)}]
}
Demo code:
puts "17 * 34 = [ethiopianMultiply 17 34 true]"
- Output:
Ethiopian multiplication of 17 and 34 17 34 KEPT 8 68 STRUCK 4 136 STRUCK 2 272 STRUCK 1 544 KEPT 17 * 34 = 578
TUSCRIPT
$$ MODE TUSCRIPT
ASK "insert number1", nr1=""
ASK "insert number2", nr2=""
SET nrs=APPEND(nr1,nr2),size_nrs=SIZE(nrs)
IF (size_nrs!=2) ERROR/STOP "insert two numbers"
LOOP n=nrs
IF (n!='digits') ERROR/STOP n, " is not a digit"
ENDLOOP
PRINT "ethopian multiplication of ",nr1," and ",nr2
SET sum=0
SECTION checkifeven
SET even=MOD(nr1,2)
IF (even==0) THEN
SET action="struck"
ELSE
SET action="kept"
SET sum=APPEND (sum,nr2)
ENDIF
SET nr1=CENTER (nr1,+6),nr2=CENTER (nr2,+6),action=CENTER (action,8)
PRINT nr1,nr2,action
ENDSECTION
SECTION halve_i
SET nr1=nr1/2
ENDSECTION
SECTION double_i
nr2=nr2*2
ENDSECTION
DO checkifeven
LOOP
DO halve_i
DO double_i
DO checkifeven
IF (nr1==1) EXIT
ENDLOOP
SET line=REPEAT ("=",20), sum = sum(sum),sum=CENTER (sum,+12)
PRINT line
PRINT sum
- Output:
ethopian multiplication of 17 and 34 17 34 kept 8 68 struck 4 136 struck 2 272 struck 1 544 kept ==================== 578
TypeScript
// Ethiopian multiplication
function double(a: number): number {
return 2 * a;
}
function halve(a: number): number {
return Math.floor(a / 2);
}
function isEven(a: number): bool {
return a % 2 == 0;
}
function showEthiopianMultiplication(x: number, y: number): void {
var tot = 0;
while (x >= 1) {
process.stdout.write(x.toString().padStart(9, ' ') + " ");
if (!isEven(x)) {
tot += y;
process.stdout.write(y.toString().padStart(9, ' '));
}
console.log();
x = halve(x);
y = double(y);
}
console.log("=" + " ".repeat(9) + tot.toString().padStart(9, ' '));
}
showEthiopianMultiplication(17, 34);
- Output:
17 34 8 4 2 1 544 = 578
UNIX Shell
Tried with bash --posix, and also with Heirloom's sh. Beware that bash --posix has more features than sh; this script uses only sh features.
halve()
{
expr "$1" / 2
}
double()
{
expr "$1" \* 2
}
is_even()
{
expr "$1" % 2 = 0 >/dev/null
}
ethiopicmult()
{
plier=$1
plicand=$2
r=0
while [ "$plier" -ge 1 ]; do
is_even "$plier" || r=`expr $r + "$plicand"`
plier=`halve "$plier"`
plicand=`double "$plicand"`
done
echo $r
}
ethiopicmult 17 34
# => 578
While breaking if the --posix flag is passed to bash, the following alternative script avoids the *, /, and % operators. It also uses local variables and built-in arithmetic.
halve() {
(( $1 >>= 1 ))
}
double() {
(( $1 <<= 1 ))
}
is_even() {
(( ($1 & 1) == 0 ))
}
multiply() {
local plier=$1
local plicand=$2
local result=0
while (( plier > 0 ))
do
is_even plier || (( result += plicand ))
halve plier
double plicand
done
echo $result
}
multiply 17 34
# => 578
C Shell
alias halve '@ \!:1 /= 2'
alias double '@ \!:1 *= 2'
alias is_even '@ \!:1 = ! ( \!:2 % 2 )'
alias multiply eval \''set multiply_args=( \!*:q ) \\
@ multiply_plier = $multiply_args[2] \\
@ multiply_plicand = $multiply_args[3] \\
@ multiply_result = 0 \\
while ( $multiply_plier > 0 ) \\
is_even multiply_is_even $multiply_plier \\
if ( ! $multiply_is_even ) then \\
@ multiply_result += $multiply_plicand \\
endif \\
halve multiply_plier \\
double multiply_plicand \\
end \\
@ $multiply_args[1] = $multiply_result \\
'\'
multiply p 17 34
echo $p
# => 578
Ursala
This solution makes use of the functions odd, double, and half, which respectively check the parity, double a given natural number, or perform truncating division by two. These functions are normally imported from the nat library but defined here explicitly for
the sake of completeness.
odd = ~&ihB
double = ~&iNiCB
half = ~&itB
The functions above are defined in terms of bit manipulations exploiting the concrete representations of natural numbers. The remaining code treats natural numbers instead as abstract types by way of the library API, and uses the operators for distribution (*-), triangular iteration (|\), and filtering (*~) among others.
#import nat
emul = sum:-0@rS+ odd@l*~+ ^|(~&,double)|\+ *-^|\~& @iNC ~&h~=0->tx :^/half@h ~&
test program:
#cast %n
test = emul(34,17)
- Output:
578
VBA
Define three named functions :
- one to halve an integer,
- one to double an integer, and
- one to state if an integer is even.
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
Use these functions to create a function that does Ethiopian multiplication. The first function below is a non optimized function :
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
This one is better :
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
Ethiopian_Multiplication = Mult_Eth
End Function
Then you can call one of these functions like this :
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
VBScript
Nowhere near as optimal a solution as the Ada. Yes, it could have made as optimal, but the long way seemed more interesting.
Demonstrates a List class. The .recall and .replace methods have bounds checking but the code does not test for the exception that would be raised. List class extends the storage allocated for the list when the occupation of the list goes beyond the original allocation.
option explicit
makes sure that all variables are declared.
Implementation
option explicit
class List
private theList
private nOccupiable
private nTop
sub class_initialize
nTop = 0
nOccupiable = 100
redim theList( nOccupiable )
end sub
public sub store( x )
if nTop >= nOccupiable then
nOccupiable = nOccupiable + 100
redim preserve theList( nOccupiable )
end if
theList( nTop ) = x
nTop = nTop + 1
end sub
public function recall( n )
if n >= 0 and n <= nOccupiable then
recall = theList( n )
else
err.raise vbObjectError + 1000,,"Recall bounds error"
end if
end function
public sub replace( n, x )
if n >= 0 and n <= nOccupiable then
theList( n ) = x
else
err.raise vbObjectError + 1001,,"Replace bounds error"
end if
end sub
public property get listCount
listCount = nTop
end property
end class
function halve( n )
halve = int( n / 2 )
end function
function twice( n )
twice = int( n * 2 )
end function
function iseven( n )
iseven = ( ( n mod 2 ) = 0 )
end function
function multiply( n1, n2 )
dim LL
set LL = new List
dim RR
set RR = new List
LL.store n1
RR.store n2
do while n1 <> 1
n1 = halve( n1 )
LL.store n1
n2 = twice( n2 )
RR.store n2
loop
dim i
for i = 0 to LL.listCount
if iseven( LL.recall( i ) ) then
RR.replace i, 0
end if
next
dim total
total = 0
for i = 0 to RR.listCount
total = total + RR.recall( i )
next
multiply = total
end function
Invocation
wscript.echo multiply(17,34)
- Output:
578
V (Vlang)
fn halve(i int) int { return i/2 }
fn double(i int) int { return i*2 }
fn is_even(i int) bool { return i%2 == 0 }
fn eth_multi(ii int, jj int) int {
mut r := 0
mut i, mut j := ii, jj
for ; i > 0; i, j = halve(i), double(j) {
if !is_even(i) {
r += j
}
}
return r
}
fn main() {
println("17 ethiopian 34 = ${eth_multi(17, 34)}")
}
- Output:
17 ethiopian 34 = 578
Wren
var halve = Fn.new { |n| (n/2).truncate }
var double = Fn.new { |n| n * 2 }
var isEven = Fn.new { |n| n%2 == 0 }
var ethiopian = Fn.new { |x, y|
var sum = 0
while (x >= 1) {
if (!isEven.call(x)) sum = sum + y
x = halve.call(x)
y = double.call(y)
}
return sum
}
System.print("17 x 34 = %(ethiopian.call(17, 34))")
System.print("99 x 99 = %(ethiopian.call(99, 99))")
- Output:
17 x 34 = 578 99 x 99 = 9801
x86 Assembly
, linking with the C standard library and start code.
extern printf
global main
section .text
halve
shr ebx, 1
ret
double
shl ebx, 1
ret
iseven
and ebx, 1
cmp ebx, 0
ret ; ret preserves flags
main
push 1 ; tutor = true
push 34 ; 2nd operand
push 17 ; 1st operand
call ethiopicmult
add esp, 12
push eax ; result of 17*34
push fmt
call printf
add esp, 8
ret
%define plier 8
%define plicand 12
%define tutor 16
ethiopicmult
enter 0, 0
cmp dword [ebp + tutor], 0
je .notut0
push dword [ebp + plicand]
push dword [ebp + plier]
push preamblefmt
call printf
add esp, 12
.notut0
xor eax, eax ; eax -> result
mov ecx, [ebp + plier] ; ecx -> plier
mov edx, [ebp + plicand] ; edx -> plicand
.whileloop
cmp ecx, 1
jl .multend
cmp dword [ebp + tutor], 0
je .notut1
call tutorme
.notut1
mov ebx, ecx
call iseven
je .iseven
add eax, edx ; result += plicand
.iseven
mov ebx, ecx ; plier >>= 1
call halve
mov ecx, ebx
mov ebx, edx ; plicand <<= 1
call double
mov edx, ebx
jmp .whileloop
.multend
leave
ret
tutorme
push eax
push strucktxt
mov ebx, ecx
call iseven
je .nostruck
mov dword [esp], kepttxt
.nostruck
push edx
push ecx
push tutorfmt
call printf
add esp, 4
pop ecx
pop edx
add esp, 4
pop eax
ret
section .data
fmt
db "%d", 10, 0
preamblefmt
db "ethiopic multiplication of %d and %d", 10, 0
tutorfmt
db "%4d %6d %s", 10, 0
strucktxt
db "struck", 0
kepttxt
db "kept", 0
Smaller version
Using old style 16 bit registers created in debug
The functions to halve double and even are coded inline. To half a value
shr,1
to double a value
shl,1
to test if the value is even
test,01
jz Even
Odd:
Even:
;calling program
1BDC:0100 6A11 PUSH 11 ;17 Put operands on the stack
1BDC:0102 6A22 PUSH 22 ;34
1BDC:0104 E80900 CALL 0110 ; call the mulitplcation routine
;putting some space in, (not needed)
1BDC:0107 90 NOP
1BDC:0108 90 NOP
1BDC:0109 90 NOP
1BDC:010A 90 NOP
1BDC:010B 90 NOP
1BDC:010C 90 NOP
1BDC:010D 90 NOP
1BDC:010E 90 NOP
1BDC:010F 90 NOP
;mulitplication routine starts here
1BDC:0110 89E5 MOV BP,SP ; prepare to get operands off stack
1BDC:0112 8B4E02 MOV CX,[BP+02] ; Get the first operand
1BDC:0115 8B5E04 MOV BX,[BP+04] ; get the second oerand
1BDC:0118 31C0 XOR AX,AX ; zero out the result
1BDC:011A F7C10100 TEST CX,0001 ; are we odd
1BDC:011E 7402 JZ 0122 ; no skip the next instruction
1BDC:0120 01D8 ADD AX,BX ; we are odd so add to the result
1BDC:0122 D1E3 SHL BX,1 ; multiply by 2
1BDC:0124 D1E9 SHR CX,1 ; divide by 2 (if zr flag is set, we are done)
1BDC:0126 75F2 JNZ 011A ; cx not 0, go back and do it again
1BDC:0128 C3 RET ; return with the result in AX
;pretty small, just 24 bytes
XPL0
include c:\cxpl\codes; \intrinsic 'code' declarations
func Halve(N); \Return half of N
int N;
return N>>1;
func Double(N); \Return N doubled
int N;
return N<<1;
func IsEven(N); \Return 'true' if N is an even number
int N;
return (N&1)=0;
func EthiopianMul(A, B); \Multiply A times B using Ethiopian method
int A, B;
int I, J, S, Left(100), Right(100);
[Left(0):= A; Right(0):= B; \1. write numbers to be multiplied
I:= 1; \2. repeatedly halve number on left
repeat A:= Halve(A);
Left(I):= A; I:= I+1;
until A=1;
J:= 1; \3. repeatedly double number on right
repeat B:= Double(B);
Right(J):= B; J:= J+1;
until J=I; \stop where left column = 1
for J:= 0 to I-1 do \4. discard right value if left is even
if IsEven(Left(J)) then Right(J):= 0;
S:= 0; \5. sum remaining values on right
for J:= 0 to I-1 do
S:= S + Right(J);
for J:= 0 to I-1 do \show this insanity
[IntOut(0, Left(J)); ChOut(0, 9\tab\); IntOut(0, Right(J)); CrLf(0)];
Text(0, " --------
");
return S; \sum = product
];
int Product;
[Product:= EthiopianMul(17, 34);
ChOut(0, 9); IntOut(0, Product); CrLf(0); CrLf(0);
Product:= EthiopianMul(1234, 5678);
ChOut(0, 9); IntOut(0, Product); CrLf(0);
]
- Output:
17 34 8 0 4 0 2 0 1 544 -------- 578 1234 0 617 11356 308 0 154 0 77 90848 38 0 19 363392 9 726784 4 0 2 0 1 5814272 -------- 7006652
zig
// programme multiplication ethiopienne
// Ethiopian multiplication
const std = @import("std");
const expect = std.testing.expect;
const print = @import("std").debug.print;
pub fn main() !void {
const Res = multiEth(17,34);
print("Resultat= {} \n", .{ Res });
}
test "Ethiopian multiplication" {
try expect(multiEth(20, 10) == 200);
try expect(multiEth(101, 101) == 10201);
try expect(multiEth(20, 0) == 0);
try expect(multiEth(0, 71) == 0);
}
//*****************************
// multiplication
//*****************************
fn multiEth(X: i64, Y: i64) i64 {
var X1=X;
var Y1=Y;
var sum: i64 = 0;
while (X1>=1) {
if ((@mod(X1,2)) == 1)
sum += Y1;
Y1= Y1 * 2;
X1 = @divFloor(X1,2);
}
return sum;
}
- Output:
Resultat= 578
zkl
Trying to duplicate the task as stated, using columns. isEven is a integer method.
fcn ethiopianMultiply(l,r){ // l is a non-negative integer
halve :=fcn(n){ n/2 };
double :=fcn(n){ n+n };
lr:=List(T(l,r)); // ( (l,r) .. (1,r*n) )
while(l>1){ lr.write( T(l=halve(l),r=double(r)) ) }
lr.filter(fcn([(l,r)]){ (not l.isEven) }); // strike out even left rows
.reduce(fcn(sum,[(l,r)]){ sum + r },0); // sum right column
}
foreach l,r in ( T(T(17,34),T(34,1),T(34,2),T(34,0)) ){
println(ethiopianMultiply(l,r)," ",ethiopianMultiply(r,l));
}
- Output:
578 578 34 34 68 68 0 0
Z80 Assembly
org &8000
ld hl,17
call Halve_Until_1
push bc
ld hl,34
call Double_Until_1
pop bc
call SumOddEntries
;returns Ethiopian product in IX.
call NewLine
call Primm
byte "0x",0
push ix
pop hl
ld a,H
call ShowHex
;Output should be in decimal but hex is easier.
ld a,L
call ShowHex
ret
Halve_Until_1:
;input: HL = number you wish to halve. HL is unsigned.
ld de,Column_1
ld a,1
ld (Column_1),HL
inc de
inc de
loop_HalveUntil_1:
SRL H
RR L
inc b
push af
ld a,L
ld (de),a
inc de
ld a,H
ld (de),a
inc de
pop af
CP L
jr nz,loop_HalveUntil_1
;b tracks how many times to double the second factor.
ret
Double_Until_1:
;doubles second factor B times. B is calculated by Halve_until_1
ld de,Column_2
ld (Column_2),HL
inc de
inc de
loop_double_until_1:
SLA L
RL H
PUSH AF
LD A,L
LD (DE),A
INC DE
LD A,H
LD (DE),A
INC DE
POP AF
DJNZ loop_double_until_1
ret
SumOddEntries:
sla b ;double loop counter, this is also the offset to the "last" entry of
;each table
ld h,>Column_1
ld d,>Column_2 ;aligning the tables lets us get away with this.
ld l,b
ld e,b
ld ix,0
loop:
ld a,(hl)
rrca ;we only need the result of the odd/even test.
jr nc,skipEven
push hl
push de
ld a,(de)
ld L,a
inc de
ld a,(de)
ld H,a
ex de,hl
add ix,de
pop de
pop hl
skipEven:
dec de
dec de
dec hl
dec hl
djnz loop
ret ;ix should contain the answer
align 8 ;aligns Column_1 to the nearest 256 byte boundary. This makes offsetting easier.
Column_1:
ds 16,0
align 8 ;aligns Column_2 to the nearest 256 byte boundary. This makes offsetting easier.
Column_2:
ds 16,0
- Output:
Output is in hex but is otherwise correct.
0x0242
ZX Spectrum Basic
10 DEF FN e(a)=a-INT (a/2)*2-1
20 DEF FN h(a)=INT (a/2)
30 DEF FN d(a)=2*a
40 LET x=17: LET y=34: LET tot=0
50 IF x<1 THEN GO TO 100
60 PRINT x;TAB (4);
70 IF FN e(x)=0 THEN LET tot=tot+y: PRINT y: GO TO 90
80 PRINT "---"
90 LET x=FN h(x): LET y=FN d(y): GO TO 50
100 PRINT TAB (4);"===",TAB (4);tot
- Programming Tasks
- Arithmetic operations
- 11l
- 8080 Assembly
- AArch64 Assembly
- ACL2
- Action!
- ActionScript
- Ada
- Aime
- ALGOL 68
- ALGOL-M
- ALGOL W
- AppleScript
- ARM Assembly
- Arturo
- AutoHotkey
- AutoIt
- AWK
- BASIC
- Applesoft BASIC
- ASIC
- BASIC256
- BBC BASIC
- Chipmunk Basic
- FreeBASIC
- GW-BASIC
- Liberty BASIC
- Microsoft Small Basic
- Minimal BASIC
- MSX Basic
- Nascom BASIC
- PureBasic
- QB64
- Sinclair ZX81 BASIC
- Tiny BASIC
- True BASIC
- XBasic
- Yabasic
- Batch File
- BCPL
- Bracmat
- BQN
- C
- C sharp
- System.Linq
- C++
- Clojure
- CLU
- COBOL
- CoffeeScript
- ColdFusion
- Common Lisp
- Craft Basic
- D
- Dc
- Delphi
- Draco
- E
- EasyLang
- Ed
- Eiffel
- Ela
- Elixir
- Emacs Lisp
- EMal
- Erlang
- ERRE
- Euphoria
- F Sharp
- Factor
- FALSE
- Forth
- Fortran
- Fōrmulæ
- FutureBasic
- Go
- Haskell
- HicEst
- Icon
- Unicon
- J
- Java
- JavaScript
- Jq
- Jsish
- Julia
- Kotlin
- Lambdatalk
- Limbo
- Locomotive Basic
- Logo
- LOLCODE
- Lua
- M2000 Interpreter
- Mathematica
- Wolfram Language
- MATLAB
- Maxima
- Metafont
- МК-61/52
- MMIX
- Modula-2
- Modula-3
- MUMPS
- Nemerle
- NetRexx
- Nim
- Objeck
- Object Pascal
- Objective-C
- OCaml
- Octave
- Oforth
- Ol
- OoRexx
- Oz
- PARI/GP
- Pascal
- PascalABC.NET
- Perl
- Phix
- PHP
- Picat
- PicoLisp
- Pike
- PL/I
- PL/M
- PL/SQL
- Plain English
- Powerbuilder
- PowerShell
- Prolog
- Python
- Quackery
- R
- Racket
- Raku
- Rascal
- Red
- Relation
- REXX
- Ring
- RPL
- Ruby
- Rust
- S-BASIC
- Scala
- Scheme
- Seed7
- Sidef
- Smalltalk
- SNOBOL4
- SNUSP
- Soar
- Swift
- Tcl
- TUSCRIPT
- TypeScript
- UNIX Shell
- C Shell
- Ursala
- VBA
- VBScript
- V (Vlang)
- Wren
- X86 Assembly
- XPL0
- Zig
- Zkl
- Z80 Assembly
- ZX Spectrum Basic
- Arithmetic
- Pages with too many expensive parser function calls