Ethiopian multiplication: Difference between revisions
m
→{{header|EasyLang}}
| (213 intermediate revisions by 68 users not shown) | |||
Line 1:
{{task|Arithmetic operations}}
'''Method:''' <br>
# 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.
Line 9 ⟶ 10:
# 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
17 34
Halving the first column:
Line 39 ⟶ 41:
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'''.
<br>
Use these functions to '''create a function that does Ethiopian multiplication'''.
;Related tasks:
* [[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.ncetm.org.uk/blogs/3064 Ethiopian 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]
<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}}==
<
(defun halve (x)
Line 70 ⟶ 311:
0
y)
(multiply (halve x) (double y)))))</
=={{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}}
<
return ((a-(a%2))/2);
}
Line 103 ⟶ 382:
trace("="+" "+r);
}
}</
ex. Ethiopian(17,34);
17 34
Line 110 ⟶ 389:
2 272 Strike
1 544 Keep
=={{header|Ada}}==
<syntaxhighlight lang="ada">
with ada.text_io;use ada.text_io;
procedure
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;</syntaxhighlight>
=={{header|Aime}}==
{{trans|C}}
<
halve(integer &x)
{
Line 213 ⟶ 465:
return 0;
}</
17 34 kept
8 68 struck
Line 229 ⟶ 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}} -->
<
PROC doublit = (REF INT x)VOID: x := ABS(BIN x SHL 1);
PROC iseven = (#CONST# INT x)BOOL: NOT ODD x;
Line 257 ⟶ 509:
(
printf(($g(0)l$, ethiopian(17, 34, TRUE)))
)</
ethiopian multiplication of 17 by 34
0017 000034 kept
Line 265 ⟶ 517:
0001 000544 kept
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>
=={{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}}==
<
; func definitions:
Line 295 ⟶ 897:
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 )
}</
=={{header|AutoIt}}==
<syntaxhighlight lang="autoit">
Func Halve($x)
Return Int($x/2)
Line 337 ⟶ 940:
MsgBox(0, "Ethiopian multiplication of 17 by 34", Ethiopian(17, 34) )
</syntaxhighlight>
=={{header|AWK}}==
Implemented without the tutor.
<
{
return int(x/2)
Line 370 ⟶ 974:
BEGIN {
print ethiopian(17, 34)
}</
=={{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)
Line 406 ⟶ 1,071:
FUNCTION isEven% (a AS INTEGER)
isEven% = (a MOD 2) - 1
END FUNCTION</
{{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}}===
<
y% = 34
Line 436 ⟶ 1,134:
DEF FNhalve(A%) = A% DIV 2
DEF FNeven(A%) = ((A% AND 1) = 0)</
{{out}}
<pre> 17 34
8 ---
4 ---
Line 443 ⟶ 1,142:
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}}==
<
& (double=.2*!arg)
& (isEven=.mod$(!arg.2):0)
Line 470 ⟶ 1,868:
)
& out$(mul$(17.34))
);</
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}}==
<
#include <stdbool.h>
Line 506 ⟶ 1,919:
printf("%d\n", ethiopian(17, 34, true));
return 0;
}</
=={{header|C sharp|C#}}==
Line 573 ⟶ 1,925:
{{works with|c sharp|C#|3+}}<br>
{{libheader|System.Linq}}<br>
<
using System;
using System.Linq;
Line 635 ⟶ 1,987:
}
}
}</
=={{header|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.
<syntaxhighlight lang="cpp">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;
}</syntaxhighlight>
=={{header|Clojure}}==
<
(bit-shift-right n 1))
Line 661 ⟶ 2,075:
(if (even a)
(recur (halve a) (twice b) r)
(recur (halve a) (twice b) (+ r b))))))</
=={{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}}
Line 667 ⟶ 2,114:
{{works with|OpenCOBOL|1.1}}
In COBOL, ''double'' is a reserved word, so the doubling functions is named ''twice'', instead.
<
IDENTIFICATION DIVISION.
Line 759 ⟶ 2,206:
SUBTRACT m FROM 1 GIVING m END-SUBTRACT
GOBACK.
END PROGRAM evenp.</
=={{header|CoffeeScript}}==
<
halve = (n) -> Math.floor n / 2
double = (n) -> n * 2
Line 779 ⟶ 2,227:
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}}==
Version with as a function of functions:
<
<cfargument name="number" type="numeric" required="true">
<cfset answer = number * 2>
Line 817 ⟶ 2,270:
<cfoutput>#ethiopian(17,34)#</cfoutput></
<cfset Number_B = 34>
<cfset Result = 0>
Line 873 ⟶ 2,326:
...equals #Result#
</cfoutput></
Sample output:<pre>
Ethiopian multiplication of 17 and 34...
Line 886 ⟶ 2,339:
=={{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.)<
(flet ((halve (n) (floor n 2))
(double (n) (* n 2))
Line 893 ⟶ 2,346:
(l l (halve l))
(r r (double r)))
((zerop l) product))))</
=={{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}}==
<
in {
assert(n1 >= 0, "Multiplier can't be negative");
Line 922 ⟶ 2,432:
writeln("17 ethiopian 34 is ", ethiopian(17, 34));
}</
17 ethiopian 34 is 578
=={{header|dc}}==
<
[ 2 / ] sH [ Define "halve" function in register H ]sx
[ 2 * ] sD [ Define "double" function in register D ]sx
Line 954 ⟶ 2,465:
[ Demo by multiplying 17 and 34 ]sx
17 34 lMx p</
{{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}}==
<
def double(&x) { x *= 2 }
def even(x) { return x %% 2 <=> 0 }
Line 970 ⟶ 2,504:
}
return ab
}</
=={{header|EasyLang}}==
<syntaxhighlight>
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|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>
Line 1,040 ⟶ 2,631:
=={{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)
Line 1,054 ⟶ 2,644:
(setq l (halve l))
(setq r (double r)))
sum))</syntaxhighlight>
=={{header|
<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}}==
<
-export([multiply/2]).
Line 1,093 ⟶ 2,693:
false ->
multiply(halve(LHS),double(RHS),Acc+RHS)
end.</
=={{header|ERRE}}==
<
FUNCTION EVEN(A)
Line 1,119 ⟶ 2,719:
PRINT("=",TOT)
END PROGRAM
</syntaxhighlight>
{{out}}
17 34
Line 1,129 ⟶ 2,729:
=={{header|Euphoria}}==
<
return floor(n/2)
end function
Line 1,159 ⟶ 2,759:
printf(1,"\nPress Any Key\n",{})
while (get_key() = -1) do end while</
=={{header|F Sharp|F#}}==
<
let halve n = n / 2
let double n = n * 2
Line 1,169 ⟶ 2,770:
else if even n then loop (halve n) (double m) result
else loop (halve n) (double m) (result + m)
loop n m 0</
=={{header|Factor}}==
<
IN: ethiopian-multiplication
Line 1,188 ⟶ 2,789:
[ odd? [ + ] [ drop ] if ] 2keep
[ double ] [ halve ] bi*
] while 2drop ;</
=={{header|FALSE}}==
<
[2*]d:
[$2/2*-]o:
[0[@$][$o;![@@\$@+@]?h;!@d;!@]#%\%]m:
17 34m;!. {578}</
=={{header|Forth}}==
Halve and double are standard words, spelled '''2/''' and '''2*''' respectively.
<
: e* ( x y -- x*y )
dup 0= if nip exit then
over 2* over 2/ recurse
swap even? if nip else + then ;</
=={{header|Fortran}}==
{{works with|Fortran|90 and later}}<
implicit none
Line 1,261 ⟶ 2,864:
end function ethiopic
end program EthiopicMult</
=={{header|
{{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}}==
<
import "fmt"
Line 1,391 ⟶ 2,936:
func main() {
fmt.Printf("17 ethiopian 34 = %d\n", ethMulti(17, 34))
}</
=={{header|Haskell}}==
===Using integer (+)===
<syntaxhighlight lang="haskell">import Prelude hiding (odd)
import Control.Monad (join)
halve
halve = (`div` 2)
double = join (+)
odd :: Int -> Bool
odd = (== 1) . (`mod` 2)
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
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>
===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.
<syntaxhighlight lang="haskell">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]</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}}==
<
END ! of "main"
Line 1,449 ⟶ 3,129:
FUNCTION isEven( x )
isEven = MOD(x, 2) == 0
END </
=={{header|Icon}} and {{header|Unicon}}==
<
while ethiopian(integer(get(arglist)),integer(get(arglist))) # multiply successive pairs of command line arguments
end
Line 1,472 ⟶ 3,153:
procedure even(i)
return ( i % 2 = 0, i )
end</
local p,w
w := *j+3
Line 1,490 ⟶ 3,171:
write(right("=",w),right(p,w))
return p
end</
=={{header|J}}==
'''Solution''':<
halve =: %&2 NB. or the primitive -:
odd =: 2&|
ethiop =: +/@(odd@] # (double~ <@#)) (1>.<.@halve)^:a:</
'''Example''':
Line 1,507 ⟶ 3,188:
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.<
Alternatively, if multiplying by negative 1 is prohibited, you can use a conditional function which optionally negates its argument.<
Examples:<
77
7 ethio _11
Line 1,517 ⟶ 3,198:
_77
_7 ethio _11
77</
=={{header|Java}}==
{{works with|Java|1.5+}}
<
import java.util.Map;
import java.util.Scanner;
Line 1,560 ⟶ 3,242:
return (num & 1) == 0;
}
}</
* This method will use ethiopian styled multiplication.
* @param a Any non-negative integer.
Line 1,610 ⟶ 3,292:
}
return result;
}</
=={{header|JavaScript}}==
<syntaxhighlight lang="javascript">var eth = {
halve : function ( n ){ return Math.floor(n/2); },
Line 1,635 ⟶ 3,318:
}
}
// 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)
<syntaxhighlight lang="javascript">function ethMult(m, n) {
var o = !isNaN(m) ? 0 : ''; // same technique works with strings
if (n < 1) return o;
while (n
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
a = halve(a)
b = double(b)
end
return
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]
Line 1,673 ⟶ 3,441:
push!(B, double(B[end]))
end
return sum(B[
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 double(n: Int) = n * 2
fun isEven(n: Int) = n % 2 == 0
fun ethiopianMultiply(x: Int, y: Int): Int {
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}}==
<
20 DEF FNhalf(a)=INT(a/2)
30 DEF FNdouble(a)=2*a
Line 1,746 ⟶ 3,611:
80 x=FNhalf(x):y=FNdouble(y)
90 WEND
100 PRINT "=", tot</
Output:
Line 1,759 ⟶ 3,624:
=={{header|Logo}}==
<
output ashift :x 1
end
Line 1,773 ⟶ 3,638:
[output eproduct halve :x double :y] ~
[output :y + eproduct halve :x double :y]
end</
=={{header|LOLCODE}}==
<
HOW IZ I Halve YR Integer
Line 1,805 ⟶ 3,670:
VISIBLE I IZ EthiopianProdukt YR 17 AN YR 34 MKAY
KTHXBYE</
Output: <pre>578</pre>
=={{header|Lua}}==
<
return a/2
end
Line 1,837 ⟶ 3,702:
end
print(ethiopian(17, 34))</
=={{header|
<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
Line 1,846 ⟶ 3,748:
Total[Select[NestWhileList[{IntegerHalving[#[[1]]],IntegerDoubling[#[[2]]]}&, {x,y}, (#[[1]]>1&)], OddQ[#[[1]]]&]][[2]]
Ethiopian[17, 34]</
Output:
<pre>578</pre>
=={{header|MATLAB}}==
Line 1,880 ⟶ 3,759:
halveInt.m:
<
result = idivide(number,2,'floor');
end</
doubleInt.m:
<
result = times(2,number);
end</
isEven.m:
<
function trueFalse = isEven(number)
trueFalse = logical( mod(number,2)==0 );
end</
ethiopianMultiplication.m:
<
%Generate columns
Line 1,916 ⟶ 3,795:
answer = sum(multiplier);
end</
Sample input: (with data type coercion)
<
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}}==
Implemented without the ''tutor''.
<syntaxhighlight lang="metafont">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</syntaxhighlight>
=={{header|МК-61/52}}==
<syntaxhighlight lang="text">П1 П2 <-> П0
ИП0 1 - x#0 29
ИП1 2 * П1
Line 1,933 ⟶ 3,855:
2 / {x} x#0 04 ИП2 ИП1 + П2
БП 04
ИП2 С/П</
=={{header|MMIX}}==
Line 1,939 ⟶ 3,861:
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.
<
B IS 34
Line 1,989 ⟶ 3,911:
% 'str' points to the start of the result
TRAP 0,Fputs,StdOut % output answer to stdout
TRAP 0,Halt,0 % exit</
Assembling:
<pre>~/MIX/MMIX/Progs> mmixal ethiopianmult.mms</pre>
Line 1,995 ⟶ 3,917:
<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}}==
{{trans|Ada}}
<
IMPORT IO, Fmt;
Line 2,035 ⟶ 4,015:
BEGIN
IO.Put("17 times 34 = " & Fmt.Int(Multiply(17, 34)) & "\n");
END Ethiopian.</
=={{header|MUMPS}}==
<syntaxhighlight lang="mumps">
HALVE(I)
;I should be an integer
Line 2,053 ⟶ 4,035:
Write !,?W,$Justify(A,W),!
Kill W,A,E,L
Q</
USER>D E2^ROSETTA(1439,7)
Multiplying two numbers:
Line 2,069 ⟶ 4,051:
=======
10073
=={{header|Nemerle}}==
<
using System.Console;
Line 2,096 ⟶ 4,079:
WriteLine("By Ethiopian multiplication, 17 * 34 = {0}", Multiply(17, 34));
}
}</
=={{header|NetRexx}}==
{{trans|REXX}}
<
options replace format comments java crossref savelog symbols nobinary
Line 2,129 ⟶ 4,113:
method iseven(x) private static
return x//2 == 0</
=={{header|Nim}}==
<
proc double(x: int): int = x * 2
proc
proc ethiopian(x, y: int): int =
var x = x
var y = y
while x >= 1:
if
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:<
interface
Line 2,184 ⟶ 4,216:
end;
begin
end.</
uses
Line 2,191 ⟶ 4,223:
begin
WriteLn('17 * 34 = ', Ethiopian(17, 34))
end.</
17 * 34 = 578
=={{header|Objective-C}}==
Using class methods except for the generic useful function <tt>iseven</tt>.
<
BOOL iseven(int x)
Line 2,237 ⟶ 4,270:
}
return 0;
}</
=={{header|OCaml}}==
<
the right column on-the-fly, like in the C version.
The function takes "halve" and "double" operators and "is_even" predicate as arguments,
Line 2,340 ⟶ 4,330:
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". *)</
=={{header|Octave}}==
<
r = floor(a/2);
endfunction
Line 2,376 ⟶ 4,366:
endfunction
disp(ethiopicmult(17, 34, true))</
=={{header|Oforth}}==
Line 2,385 ⟶ 4,374:
isEven is already defined for Integers.
<
dup ifZero: [ nip return ]
over double over halve ethiopian
swap isEven ifTrue: [ nip ] else: [ + ] ;</syntaxhighlight>
{{out}}
<pre>
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}}==
<
fun {Halve X} X div 2 end
fun {Double X} X * 2 end
Line 2,433 ⟶ 4,448:
fun {Sum Xs} {FoldL Xs Number.'+' 0} end
in
{Show {EthiopicMult 17 34}}</
=={{header|PARI/GP}}==
<
double(n)=2*n;
even(n)=!(n%2);
Line 2,445 ⟶ 4,461:
b=double(b));
d
};</
=={{header|Pascal}}==
<
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
function Double(Number: Integer): Integer;
begin
end;
function Halve(Number: Integer): Integer;
begin
end;
function Even(Number: Integer): Boolean;
begin
end;
function Ethiopian(NumberA, NumberB: Integer): Integer;
begin
while NumberA >= 1 do
begin
if not Even(NumberA) then
NumberA := Halve(NumberA);
NumberB := Double(NumberB)
Line 2,479 ⟶ 4,497:
begin
Write(Ethiopian(17, 34))
end.</
=={{header|Perl}}==
<
sub halve { int((shift) / 2); }
Line 2,504 ⟶ 4,523:
}
print ethiopicmult(17,34, 1), "\n";</
=={{header|Phix}}==
{{Trans|Euphoria}}
<!--<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>
<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>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<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>
<span style="color: #008080;">return</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">*</span><span style="color: #000000;">2</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<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>
<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>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<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>
<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}}==
Not object oriented version:<
function halve($x)
{
Line 2,584 ⟶ 4,586:
echo ethiopicmult(17, 34, true), "\n";
?></
ethiopic multiplication of 17 and 34
17, 34 kept
Line 2,593 ⟶ 4,595:
578
Object Oriented version:
{{works with|PHP5}}<
class ethiopian_multiply {
Line 2,637 ⟶ 4,639:
echo ethiopian_multiply::init(17, 34);
?></
=={{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}}==
<
(/ N 2) )
Line 2,656 ⟶ 4,747:
X (halve X)
Y (double Y) ) )
R ) )</
=={{header|Pike}}==
<
{
int halve(int n) { return n/2; };
Line 2,675 ⟶ 4,767:
while(l);
return product;
}</
=={{header|PL/I}}==
<syntaxhighlight lang="pl/i">
declare (L(30), R(30)) fixed binary;
declare (i, s) fixed binary;
Line 2,707 ⟶ 4,799:
odd: procedure (k) returns (bit (1));
return (iand(k, 1) ^= 0);
end odd;</
=={{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}}==
This code was taken from the ADA example above - very minor differences.
<
function multiply
Line 2,768 ⟶ 4,934:
dbms_output.put_line(ethiopian.multiply(17, 34));
end;
/</
=={{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}}==
<
end function
Line 2,797 ⟶ 5,002:
// example call
long ll_answer
ll_answer = wf_ethiopianmultiplication(17,34)</
=={{header|PowerShell}}==
===Traditional===
<
param ([int]$value)
return [bool]($value % 2 -eq 0)
Line 2,834 ⟶ 5,040:
}
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.
<
{
[math]::floor( $rhs / 2 )
Line 2,865 ⟶ 5,071:
}
Ethiopian 17 34</
=={{header|Prolog}}==
=== Traditional ===
<
double(X,Y) :- Y is 2*X.
is_even(X) :- 0 is X mod 2.
Line 2,892 ⟶ 5,099:
columns(First,Second,Left,Right),
maplist(contribution,Left,Right,Contributions),
sumlist(Contributions,Product).</
Line 2,899 ⟶ 5,106:
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
<
% halve/2, double/2, is_even/2 definitions go here
Line 2,910 ⟶ 5,117:
ethiopian(First,Second,Sum0,Sum) :-
Sum1 is Sum0 + Second*(First mod 2),
ethiopian(halve $ First, double $ Second, Sum1, Sum).</
Line 2,916 ⟶ 5,123:
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).
<
:- use_module(library(chr)).
Line 2,940 ⟶ 5,147:
test :-
mul(17, 34, Z), !,
writeln(Z).</
<
:- use_module(library(chr)).
Line 2,962 ⟶ 5,169:
test :-
mul(17, 34, Z),
writeln(Z).</
=={{header|Python}}==
===Python: With tutor===
<
def halve(x):
return x // 2
def double(x):
return x * 2
def even(x):
Line 3,058 ⟶ 5,186:
def ethiopian(multiplier, multiplicand):
if tutor:
print(
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:
return result</syntaxhighlight>
Sample output
Line 3,091 ⟶ 5,222:
Without the tutorial code, and taking advantage of Python's lambda:
<
double = lambda x: x*2
even = lambda x: not x % 2
Line 3,104 ⟶ 5,235:
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.<
from itertools import izip, takewhile
Line 3,148 ⟶ 5,279:
if tutor:
show_result(result)
return result</
>>> ethiopian(17, 34)
Multiplying 17 by 34 using Ethiopian multiplication:
Line 3,160 ⟶ 5,291:
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}}==
===R: With tutor===
<syntaxhighlight lang="r">halve <- function(a) floor(a/2)
double <- function(a) a*2
iseven <- function(a) (a%%2)==0
Line 3,179 ⟶ 5,475:
}
print(ethiopicmult(17, 34, TRUE))</
===R: Without tutor===
Simplified version.
<syntaxhighlight lang="r">
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))
</syntaxhighlight>
=={{header|Racket}}==
<
(define (halve i) (quotient i 2))
Line 3,192 ⟶ 5,509:
[else (+ y (ethiopian-multiply (halve x) (double y)))]))
(ethiopian-multiply 17 34) ; -> 578</
=={{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}}==
<
public int halve(int n) = n/2;
Line 3,212 ⟶ 5,577:
}
return result;
} </
=={{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. */
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}}==
Iterative and recursive implementations here.
I've chosen to highlight the example 20*5 which I think is more illustrative.
<syntaxhighlight lang
def double(x) = x*2
# iterative
Line 3,273 ⟶ 5,796:
$DEBUG = true # $DEBUG also set to true if "-d" option given
a, b = 20, 5
puts "#{a} * #{b} = #{ethiopian_multiply(a,b)}"; puts</
{{out}}
Line 3,285 ⟶ 5,808:
A test suite:
<
class EthiopianTests < Test::Unit::TestCase
def test_iter1; assert_equal(578, ethopian_multiply(17,34)); end
Line 3,299 ⟶ 5,822:
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</
<pre>Run options:
Line 3,313 ⟶ 5,836:
=={{header|Rust}}==
<
2*a
}
fn halve(a
a/2
}
fn is_even(a
}
fn ethiopian_multiplication(mut x
false => {
println!("\t Kept");
sum += y;
}
}
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}}==
Line 3,347 ⟶ 5,943:
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}
Line 3,374 ⟶ 5,970:
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.
<
(quotient num 2))
Line 3,393 ⟶ 5,989:
(display (mul-eth 17 34))
(newline)</
Output:
578
=={{header|Seed7}}==
Ethiopian Multiplication is another name for the peasant multiplication:
<
begin
a *:= 2;
Line 3,423 ⟶ 6,020:
double(b);
end while;
end func;</
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}}==
{{works with|GNU Smalltalk}}
<
double [ ^ self * 2 ]
halve [ ^ self // 2 ]
Line 3,460 ⟶ 6,078:
]
ethiopianMultiplyBy: aNumber [ ^ self ethiopianMultiplyBy: aNumber withTutor: false ]
].</
<
=={{header|SNOBOL4}}==
<
define('halve(num)') :(halve_end)
halve eq(num,1) :s(freturn)
Line 3,486 ⟶ 6,104:
l = halve(l) :s(next)
stop output = s
end</
=={{header|SNUSP}}==
<
| | /-\ /recurse\ #/?\ zero
$>,@/>,@/?\<=zero=!\?/<=print==!\@\>?!\@/<@\.!\-/
Line 3,500 ⟶ 6,118:
\>+<-/ | \=<<<!/====?\=\ | double
! # | \<++>-/ | |
\=======\!@>============/!/</
This is possibly the smallest multiply routine so far discovered for SNUSP.
=={{header|Soar}}==
<
# multiply takes ^left and ^right numbers
# and a ^return-to
Line 3,568 ⟶ 6,186:
^answer <a>)
-->
(<r> ^multiply-done <a>)}</
=={{header|Swift}}==
<
func ethiopian(var #int1:Int, var #int2:Int) -> Int {
func isEven(#n:Int) -> Bool {return n % 2 == 0}
while int1 != 1 {
int1 =
}
var returnInt = 0
for (a,b) in zip(lhs, rhs) {
if (!isEven(n: a)) {
returnInt += b
}
}
return returnInt
}
println(ethiopian(int1: 17, int2: 34))</
{{out}}
<pre>578</pre>
=={{header|Tcl}}==
<
proc function {name arguments body} {
uplevel 1 [list proc tcl::mathfunc::$name $arguments [list expr $body]]
Line 3,627 ⟶ 6,248:
}
return [expr {mult($a,$b)}]
}</
Ethiopian multiplication of 17 and 34
17 34 KEPT
Line 3,637 ⟶ 6,258:
=={{header|TUSCRIPT}}==
<
$$ MODE TUSCRIPT
ASK "insert number1", nr1=""
Line 3,683 ⟶ 6,304:
PRINT line
PRINT sum
</
ethopian multiplication of 17 and 34
17 34 kept
Line 3,692 ⟶ 6,313:
====================
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}}==
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.
{{works with|Bourne Shell}}
<
{
expr "$1" / 2
Line 3,725 ⟶ 6,391:
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.
Line 3,733 ⟶ 6,399:
{{works with|zsh}}
<
(( $1 >>= 1 ))
}
Line 3,760 ⟶ 6,426:
multiply 17 34
# => 578</
==={{header|C Shell}}===
<
alias double '@ \!:1 *= 2'
alias is_even '@ \!:1 = ! ( \!:2 % 2 )'
Line 3,783 ⟶ 6,450:
multiply p 17 34
echo $p
# => 578</
=={{header|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.<
double = ~&iNiCB
half = ~&itB</
and filtering (*~) among others.<
emul = sum:-0@rS+ odd@l*~+ ^|(~&,double)|\+ *-^|\~& @iNC ~&h~=0->tx :^/half@h ~&</
test = emul(34,17)</
578
=={{header|VBA}}==
Define three named functions :
# one to '''halve an integer''',
# 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.
Line 3,804 ⟶ 6,539:
<code>option explicit</code> makes sure that all variables are declared.
'''Implementation'''<
class List
Line 3,893 ⟶ 6,628:
multiply = total
end function
</
wscript.echo multiply(17,34)
</
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}}
<pre>
17 x 34 = 578
99 x 99 = 9801
</pre>
=={{header|x86 Assembly}}==
{{works with|nasm}}, linking with the C standard library and start code.
<
global main
Line 4,007 ⟶ 6,794:
db "struck", 0
kepttxt
db "kept", 0</
===Smaller version===
Using old style 16 bit registers created in debug
Line 4,020 ⟶ 6,807:
to test if the value is even
<
jz Even
Odd:
Even:</
1BDC:0100 6A11 PUSH 11 ;17 Put operands on the stack
Line 4,051 ⟶ 6,838:
1BDC:0128 C3 RET ; return with the result in AX
;pretty small, just 24 bytes </
=={{header|XPL0}}==
<
func Halve(N); \Return half of N
Line 4,096 ⟶ 6,884:
Product:= EthiopianMul(1234, 5678);
ChOut(0, 9); IntOut(0, Product); CrLf(0);
]</
<pre>17 34
8 0
Line 4,118 ⟶ 6,906:
--------
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.
<
halve :=fcn(n){ n/2 };
double :=fcn(n){ n+n };
Line 4,129 ⟶ 6,960:
lr.filter(fcn([(l,r)]){ (not l.isEven) }); // strike out even left rows
.reduce(fcn(sum,[(l,r)]){ sum + r },0); // sum right column
}</
<
println(ethiopianMultiply(l,r)," ",ethiopianMultiply(r,l));
}</
{{out}}
<pre>
Line 4,140 ⟶ 6,971:
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]]
| |||