Ethiopian multiplication: Difference between revisions
m
→{{header|EasyLang}}
m (→Haskell :: Fold after unfold: (Tidied)) |
|||
(65 intermediate revisions by 29 users not shown) | |||
Line 51:
Use these functions to '''create a function that does Ethiopian multiplication'''.
;Related tasks:
* [[Egyptian_division|Egyptian division]]
;References:
Line 63 ⟶ 65:
=={{header|11l}}==
{{trans|Python}}
<
R x I/ 2
F
R x * 2
Line 79 ⟶ 81:
result += multiplicand
multiplier = halve(multiplier)
multiplicand =
R result
print(ethiopian(17, 34))</
{{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 106 ⟶ 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 140 ⟶ 382:
trace("="+" "+r);
}
}</
ex. Ethiopian(17,34);
17 34
Line 149 ⟶ 391:
=={{header|Ada}}==
<syntaxhighlight lang="ada">
with ada.text_io;use ada.text_io;
Line 163 ⟶ 405:
begin
put_line (mul (17,34)'img);
end ethiopian;</
=={{header|Aime}}==
{{trans|C}}
<
halve(integer &x)
{
Line 223 ⟶ 465:
return 0;
}</
17 34 kept
8 68 struck
Line 239 ⟶ 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 267 ⟶ 509:
(
printf(($g(0)l$, ethiopian(17, 34, TRUE)))
)</
ethiopian multiplication of 17 by 34
0017 000034 kept
Line 277 ⟶ 519:
=={{header|ALGOL-M}}==
<
BEGIN
Line 329 ⟶ 571:
WRITE(ETHIOPIAN(17,34,YES));
END</
{{out}}
<pre>
Line 341 ⟶ 583:
=={{header|ALGOL W}}==
<
% returns half of a %
integer procedure halve ( integer value a ) ; a div 2;
Line 378 ⟶ 620:
write( " ", m )
end
end.</
{{out}}
<pre>
Line 399 ⟶ 641:
See also: [[Repeat_a_string#AppleScript]]
<
{ethMult(17, 34), ethMult("Rhind", 9)}
Line 461 ⟶ 703:
end repeat
return plus(o, m) of fns
end ethMult</
{{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}}==
<
double:
; even? already exists
Line 485 ⟶ 860:
print ethiopian 17 34
print ethiopian 2 3</
{{out}}
Line 493 ⟶ 868:
=={{header|AutoHotkey}}==
<
; func definitions:
Line 522 ⟶ 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 565 ⟶ 940:
MsgBox(0, "Ethiopian multiplication of 17 by 34", Ethiopian(17, 34) )
</syntaxhighlight>
=={{header|AWK}}==
Implemented without the tutor.
<
{
return int(x/2)
Line 599 ⟶ 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.)
<
DECLARE FUNCTION doub% (a AS INTEGER)
DECLARE FUNCTION isEven% (a AS INTEGER)
Line 640 ⟶ 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 670 ⟶ 1,134:
DEF FNhalve(A%) = A% DIV 2
DEF FNeven(A%) = ((A% AND 1) = 0)</
{{out}}
<pre> 17 34
8 ---
4 ---
Line 677 ⟶ 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}}===
<
Var answer="0"+y
Var addcarry=0
Line 767 ⟶ 1,262:
Sleep
</
{{out}}
<pre>Half Double * marks those accumulated
Biggest Smallest
Line 784 ⟶ 1,280:
==={{header|GW-BASIC}}===
{{works with|BASICA}}
<syntaxhighlight lang="gwbasic">10 REM Ethiopian multiplication
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}}===
<
y = 34
msg$ = str$(x) + " * " + str$(y) + " = "
Line 824 ⟶ 1,332:
Function doubleInt(num)
doubleInt = Int(num * 2)
End Function</
==={{header|Microsoft Small Basic}}===
<
y = 34
tot = 0
Line 846 ⟶ 1,352:
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}}===
<
ProcedureReturn (x & 1) ! 1
EndProcedure
Line 882 ⟶ 1,444:
Input()
CloseConsole()
EndIf</
{{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.
<
ProcedureReturn (x & 1) ! 1
EndProcedure
Line 923 ⟶ 1,485:
Input()
CloseConsole()
EndIf</
{{out}}
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.)
<
20 LET DOUBLE=340
30 LET EVEN=360
Line 968 ⟶ 1,559:
360 LET Y=X/2=INT (X/2)
370 RETURN
380 PRINT AT I+1,16;A</
{{in}}
<pre>17
Line 980 ⟶ 1,571:
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
Line 1,012 ⟶ 1,649:
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"
Line 1,059 ⟶ 1,694:
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}}==
<
@echo off
:: Pick 2 random, non-zero, 2-digit numbers to send to :_main
Line 1,151 ⟶ 1,815:
set /a modint=%int% %% 2
exit /b %modint%
</syntaxhighlight>
{{out}}
Line 1,164 ⟶ 1,828:
=={{header|BCPL}}==
<
let halve(i) = i>>1
Line 1,175 ⟶ 1,839:
emulr(halve(x), double(y), even(x) -> ac, ac + y)
let start() be writef("%N*N", emul(17, 34))</
{{out}}
<pre>578</pre>
=={{header|Bracmat}}==
<
& (double=.2*!arg)
& (isEven=.mod$(!arg.2):0)
Line 1,204 ⟶ 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 1,240 ⟶ 1,919:
printf("%d\n", ethiopian(17, 34, true));
return 0;
}</
=={{header|C sharp|C#}}==
Line 1,246 ⟶ 1,925:
{{works with|c sharp|C#|3+}}<br>
{{libheader|System.Linq}}<br>
<
using System;
using System.Linq;
Line 1,308 ⟶ 1,987:
}
}
}</
=={{header|C++}}==
Line 1,316 ⟶ 1,995:
Here is such an implementation without tutor, since there is no mechanism in C++ to output
messages during program compilation.
<
struct Half
{
Line 1,369 ⟶ 2,048:
std::cout << EthiopianMultiplication<17, 54>::Result << std::endl;
return 0;
}</
=={{header|Clojure}}==
<
(bit-shift-right n 1))
Line 1,396 ⟶ 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}}==
Line 1,403 ⟶ 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 1,495 ⟶ 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 1,516 ⟶ 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 1,555 ⟶ 2,270:
<cfoutput>#ethiopian(17,34)#</cfoutput></
<cfset Number_B = 34>
<cfset Result = 0>
Line 1,611 ⟶ 2,326:
...equals #Result#
</cfoutput></
Sample output:<pre>
Ethiopian multiplication of 17 and 34...
Line 1,624 ⟶ 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 1,631 ⟶ 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 1,661 ⟶ 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 1,694 ⟶ 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 1,713 ⟶ 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
return
.
print mult 17 34
</syntaxhighlight>
=={{header|Eiffel}}==
<syntaxhighlight lang="eiffel">
class
APPLICATION
Line 1,797 ⟶ 2,582:
end
</syntaxhighlight>
{{out}}
<pre>
Line 1,805 ⟶ 2,590:
=={{header|Ela}}==
Translation of Haskell:
<
halve x = x `div` 2
Line 1,814 ⟶ 2,599:
(iterate double b)
ethiopicmult 17 34</
578
=={{header|Elixir}}==
{{trans|Erlang}}
<
def halve(n), do: div(n, 2)
Line 1,837 ⟶ 2,622:
end
IO.inspect Ethiopian.multiply(17, 34)</
{{out}}
Line 1,846 ⟶ 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,860 ⟶ 2,644:
(setq l (halve l))
(setq r (double r)))
sum))</syntaxhighlight>
=={{header|EMal}}==
<syntaxhighlight lang="emal">
fun halve = int by int value do return value / 2 end
fun double = int by int value do return value * 2 end
fun isEven = logic by int value do return value % 2 == 0 end
fun ethiopian = int by int multiplicand, int multiplier
int product
while multiplicand >= 1
if not isEven(multiplicand) do product += multiplier end
multiplicand = halve(multiplicand)
multiplier = double(multiplier)
end
return product
end
writeLine(ethiopian(17, 34))
</syntaxhighlight>
{{out}}
<pre>
578
</pre>
=={{header|Erlang}}==
<
-export([multiply/2]).
Line 1,888 ⟶ 2,693:
false ->
multiply(halve(LHS),double(RHS),Acc+RHS)
end.</
=={{header|ERRE}}==
<
FUNCTION EVEN(A)
Line 1,914 ⟶ 2,719:
PRINT("=",TOT)
END PROGRAM
</syntaxhighlight>
{{out}}
17 34
Line 1,924 ⟶ 2,729:
=={{header|Euphoria}}==
<
return floor(n/2)
end function
Line 1,954 ⟶ 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,965 ⟶ 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,984 ⟶ 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 2,059 ⟶ 2,864:
end function ethiopic
end program EthiopicMult</
=={{header|Fōrmulæ}}==
{{FormulaeEntry|page=https://formulae.org/?script=examples/Ancient_Egyptian_multiplication}}
'''Solution'''
[[File:Fōrmulæ - Ancient Egyptian multiplication 01.png]]
'''Test case'''
[[File:Fōrmulæ - Ancient Egyptian multiplication 02.png]]
[[File:Fōrmulæ - Ancient Egyptian multiplication 03.png]]
Because the required functions are either simple or intrinsic, the solution can be much simpler:
[[File:Fōrmulæ - Ancient Egyptian multiplication 04.png]]
=={{header|FutureBasic}}==
<syntaxhighlight lang="futurebasic">
local fn Doubled( n as long ) : end fn = n * 2
local fn Halved( n as long ) : end fn = int( n / 2 )
local fn IsEven( n as long ) : end fn = ( n mod 2 ) - 1
local fn EthiopianMultiply( x as long, y as long )
long sum = 0, sign = x
printf @"Ethiopian multiplication of %3ld x %3ld = \b", x, y
do
if not ( fn IsEven( x ) ) then sum += y
x = fn Halved( x ) : y = fn Doubled( y )
until ( x == 0 )
if sign < 0 then sum *= - 1
printf @"%4ld", sum
end fn
fn EthiopianMultiply( 17, 34 )
fn EthiopianMultiply( -17, 34 )
fn EthiopianMultiply( -17, -34 )
HandleEvents
</syntaxhighlight>
{{output}}
<pre>
Ethiopian multiplication of 17 x 34 = 578
Ethiopian multiplication of -17 x 34 = -578
Ethiopian multiplication of -17 x -34 = 578
</pre>
=={{header|Go}}==
<
import "fmt"
Line 2,083 ⟶ 2,936:
func main() {
fmt.Printf("17 ethiopian 34 = %d\n", ethMulti(17, 34))
}</
=={{header|Haskell}}==
===Using integer (+)===
<
import Control.Monad (join)
Line 2,107 ⟶ 2,960:
main :: IO ()
main = print $ ethiopicmult 17 34 == 17 * 34</
{{Out}}
<pre>*Main> ethiopicmult 17 34
Line 2,117 ⟶ 2,970:
Logging the stages of the '''unfoldr''' and '''foldr''' applications:
<
import Data.Tuple (swap)
import Debug.Trace (trace)
Line 2,171 ⟶ 3,024:
main = do
print $ ethMult 17 34
print $ ethMult 34 17</
{{Out}}
<pre>halve: (8,1)
Line 2,209 ⟶ 3,062:
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
import Data.List (unfoldr)
import Data.Monoid (getProduct, getSum)
import Data.Tuple (swap)
----------------- ETHIOPIAN MULTIPLICATION ---------------
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
addedWhereOdd :: (Eq a, Num a, Semigroup p) => (a, p) -> p -> p
addedWhereOdd (d, x) a
| 0 /= d = a <> x
| otherwise = a
--------------------------- TEST -------------------------
Line 2,232 ⟶ 3,088:
main = do
mapM_ print $
[ getSum $ ethMult 17 34, -- 34 * 17
]
<> (getProduct <$> ([ethMult 17] <*> [3, 4]))
print $ ethMult 17 "34"
print $ ethMult 17 [3, 4]</
{{Out}}
<pre>578
Line 2,247 ⟶ 3,104:
=={{header|HicEst}}==
<
END ! of "main"
Line 2,272 ⟶ 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 2,296 ⟶ 3,153:
procedure even(i)
return ( i % 2 = 0, i )
end</
local p,w
w := *j+3
Line 2,314 ⟶ 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 2,331 ⟶ 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 2,341 ⟶ 3,198:
_77
_7 ethio _11
77</
=={{header|Java}}==
{{works with|Java|1.5+}}
<
import java.util.Map;
import java.util.Scanner;
Line 2,385 ⟶ 3,242:
return (num & 1) == 0;
}
}</
* This method will use ethiopian styled multiplication.
* @param a Any non-negative integer.
Line 2,435 ⟶ 3,292:
}
return result;
}</
=={{header|JavaScript}}==
<
halve : function ( n ){ return Math.floor(n/2); },
Line 2,461 ⟶ 3,318:
}
}
// eth.mult(17,34) returns 578</
Line 2,471 ⟶ 3,328:
<
var o = !isNaN(m) ? 0 : ''; // same technique works with strings
if (n < 1) return o;
Line 2,482 ⟶ 3,339:
}
ethMult(17, 34)</
{{Out}}
Line 2,491 ⟶ 3,348:
Note that the same function will also multiply strings with some efficiency, particularly where n is larger. See [[Repeat_a_string]]
<syntaxhighlight lang
{{Out}}
Line 2,504 ⟶ 3,361:
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:<
def double: 2 * .;
Line 2,518 ⟶ 3,375:
| select( .[0] | isEven | not)
| .[1] ) as $i
(0; . + $i) ;</
=={{header|Jsish}}==
From Javascript entry.
<
var eth = {
halve : function(n) { return Math.floor(n / 2); },
Line 2,550 ⟶ 3,407:
eth.mult(17,34) ==> 578
=!EXPECTEND!=
*/</
{{out}}
Line 2,559 ⟶ 3,416:
{{works with|Julia|0.6}}
'''Helper functions''' (type stable):
<
double(x::Integer) = Int8(2) * x
even(x::Integer) = x & 1 != 1</
'''Main function''':
<
r = 0
while a > 0
Line 2,574 ⟶ 3,431:
end
@show ethmult(17, 34)</
'''Array version''' (more similar algorithm to the one from the task description):
<
A = [a]
B = [b]
Line 2,587 ⟶ 3,444:
end
@show ethmult2(17, 34)</
{{out}}
Line 2,604 ⟶ 3,461:
=={{header|Kotlin}}==
<syntaxhighlight lang="scala">// version 1.1.2
fun halve(n: Int) = n / 2
Line 2,627 ⟶ 3,485:
println("17 x 34 = ${ethiopianMultiply(17, 34)}")
println("99 x 99 = ${ethiopianMultiply(99, 99)}")
}</
{{out}}
Line 2,634 ⟶ 3,492:
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
Line 2,665 ⟶ 3,541:
-> 578
</syntaxhighlight>
=={{header|Limbo}}==
<
include "sys.m";
Line 2,722 ⟶ 3,598:
return product;
}
</syntaxhighlight>
=={{header|Locomotive Basic}}==
<
20 DEF FNhalf(a)=INT(a/2)
30 DEF FNdouble(a)=2*a
Line 2,735 ⟶ 3,611:
80 x=FNhalf(x):y=FNdouble(y)
90 WEND
100 PRINT "=", tot</
Output:
Line 2,748 ⟶ 3,624:
=={{header|Logo}}==
<
output ashift :x 1
end
Line 2,762 ⟶ 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 2,794 ⟶ 3,670:
VISIBLE I IZ EthiopianProdukt YR 17 AN YR 34 MKAY
KTHXBYE</
Output: <pre>578</pre>
=={{header|Lua}}==
<
return a/2
end
Line 2,826 ⟶ 3,702:
end
print(ethiopian(17, 34))</
=={{header|M2000 Interpreter}}==
<syntaxhighlight lang="m2000 interpreter">
Module EthiopianMultiplication{
Form 60, 25
Line 2,863 ⟶ 3,739:
}
EthiopianMultiplication
</syntaxhighlight>
=={{header|Mathematica}} / {{header|Wolfram Language}}==
<
IntegerDoubling[x_]:=x*2;
OddInteger OddQ
Line 2,872 ⟶ 3,748:
Total[Select[NestWhileList[{IntegerHalving[#[[1]]],IntegerDoubling[#[[2]]]}&, {x,y}, (#[[1]]>1&)], OddQ[#[[1]]]&]][[2]]
Ethiopian[17, 34]</
Output:
Line 2,883 ⟶ 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 2,919 ⟶ 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''.
<
vardef double(expr x) = x*2 enddef;
vardef iseven(expr x) = if (x mod 2) = 0: true else: false fi enddef;
Line 2,950 ⟶ 3,846:
show( (17 ethiopicmult 34) );
end</
=={{header|МК-61/52}}==
<syntaxhighlight lang="text">П1 П2 <-> П0
ИП0 1 - x#0 29
ИП1 2 * П1
Line 2,959 ⟶ 3,855:
2 / {x} x#0 04 ИП2 ИП1 + П2
БП 04
ИП2 С/П</
=={{header|MMIX}}==
Line 2,965 ⟶ 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 3,015 ⟶ 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 3,024 ⟶ 3,920:
=={{header|Modula-2}}==
{{works with|ADW Modula-2|any (Compile with the linker option ''Console Application'').}}
<
MODULE EthiopianMultiplication;
Line 3,069 ⟶ 3,965:
WriteLn;
END EthiopianMultiplication.
</syntaxhighlight>
{{out}}
<pre>
Line 3,082 ⟶ 3,978:
=={{header|Modula-3}}==
{{trans|Ada}}
<
IMPORT IO, Fmt;
Line 3,119 ⟶ 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 3,138 ⟶ 4,035:
Write !,?W,$Justify(A,W),!
Kill W,A,E,L
Q</
USER>D E2^ROSETTA(1439,7)
Multiplying two numbers:
Line 3,156 ⟶ 4,053:
=={{header|Nemerle}}==
<
using System.Console;
Line 3,182 ⟶ 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 3,216 ⟶ 4,113:
method iseven(x) private static
return x//2 == 0</
=={{header|Nim}}==
<
proc double(x: int): int = x * 2
proc odd(x: int): bool = x mod 2 != 0
Line 3,233 ⟶ 4,130:
y = double y
echo ethiopian(17, 34)</
{{out}}
Line 3,239 ⟶ 4,136:
=={{header|Objeck}}==
{{trans|Java}}<
use Collection;
Line 3,280 ⟶ 4,177:
return (num and 1) = 0;
}
}</
=={{header|Object Pascal}}==
multiplication.pas:<
interface
Line 3,319 ⟶ 4,216:
end;
begin
end.</
uses
Line 3,326 ⟶ 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 3,373 ⟶ 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 3,433 ⟶ 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 3,469 ⟶ 4,366:
endfunction
disp(ethiopicmult(17, 34, true))</
=={{header|Oforth}}==
Line 3,477 ⟶ 4,374:
isEven is already defined for Integers.
<
: double 2 * ;
Line 3,483 ⟶ 4,380:
dup ifZero: [ nip return ]
over double over halve ethiopian
swap isEven ifTrue: [ nip ] else: [ + ] ;</
{{out}}
Line 3,493 ⟶ 4,390:
=={{header|Ol}}==
<syntaxhighlight lang="ol">
(define (ethiopian-multiplication l r)
(let ((even? (lambda (n)
Line 3,507 ⟶ 4,404:
(print (ethiopian-multiplication 17 34))
</syntaxhighlight>
{{out}}
Line 3,524 ⟶ 4,421:
=={{header|Oz}}==
<
fun {Halve X} X div 2 end
fun {Double X} X * 2 end
Line 3,551 ⟶ 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 3,564 ⟶ 4,461:
b=double(b));
d
};</
=={{header|Pascal}}==
<
{$IFDEF FPC}
{$MODE DELPHI}
Line 3,600 ⟶ 4,497:
begin
Write(Ethiopian(17, 34))
end.</
=={{header|Perl}}==
<
sub halve { int((shift) / 2); }
Line 3,626 ⟶ 4,523:
}
print ethiopicmult(17,34, 1), "\n";</
=={{header|Phix}}==
{{Trans|Euphoria}}
<!--<
<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>
Line 3,654 ⟶ 4,551:
<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>
<!--</
=={{header|PHP}}==
Not object oriented version:<
function halve($x)
{
Line 3,689 ⟶ 4,586:
echo ethiopicmult(17, 34, true), "\n";
?></
ethiopic multiplication of 17 and 34
17, 34 kept
Line 3,698 ⟶ 4,595:
578
Object Oriented version:
{{works with|PHP5}}<
class ethiopian_multiply {
Line 3,742 ⟶ 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 3,761 ⟶ 4,747:
X (halve X)
Y (double Y) ) )
R ) )</
=={{header|Pike}}==
<
{
int halve(int n) { return n/2; };
Line 3,781 ⟶ 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 3,813 ⟶ 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 3,874 ⟶ 4,934:
dbms_output.put_line(ethiopian.multiply(17, 34));
end;
/</
=={{header|Plain English}}==
<
\
\To cut a number in half:
Line 3,908 ⟶ 4,968:
Double the other number.
Repeat.
Put the sum into the number.</
{{out}}
<pre>
Line 3,915 ⟶ 4,975:
=={{header|Powerbuilder}}==
<
end function
Line 3,942 ⟶ 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 3,980 ⟶ 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 4,011 ⟶ 5,071:
}
Ethiopian 17 34</
=={{header|Prolog}}==
Line 4,017 ⟶ 5,077:
=== Traditional ===
<
double(X,Y) :- Y is 2*X.
is_even(X) :- 0 is X mod 2.
Line 4,039 ⟶ 5,099:
columns(First,Second,Left,Right),
maplist(contribution,Left,Right,Contributions),
sumlist(Contributions,Product).</
Line 4,046 ⟶ 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 4,057 ⟶ 5,117:
ethiopian(First,Second,Sum0,Sum) :-
Sum1 is Sum0 + Second*(First mod 2),
ethiopian(halve $ First, double $ Second, Sum1, Sum).</
Line 4,063 ⟶ 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 4,087 ⟶ 5,147:
test :-
mul(17, 34, Z), !,
writeln(Z).</
<
:- use_module(library(chr)).
Line 4,109 ⟶ 5,169:
test :-
mul(17, 34, Z),
writeln(Z).</
=={{header|Python}}==
===Python: With tutor===
<
def halve(x):
Line 4,143 ⟶ 5,203:
if tutor:
print()
return result</
Sample output
Line 4,162 ⟶ 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 4,175 ⟶ 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 4,219 ⟶ 5,279:
if tutor:
show_result(result)
return result</
>>> ethiopian(17, 34)
Multiplying 17 by 34 using Ethiopian multiplication:
Line 4,238 ⟶ 5,298:
Avoiding the use of the multiplication operator, and defining a catamorphism applied over an anamorphism.
<
from functools import reduce
Line 4,345 ⟶ 5,405:
if __name__ == '__main__':
main()
</syntaxhighlight>
{{Out}}
<pre>halve: (8, 1)
Line 4,381 ⟶ 5,441:
Extended to handle negative numbers.
<
[ 1 << ] is double ( n --> n )
Line 4,393 ⟶ 5,453:
swap even
iff nip else + ]
swap if negate ] is e* ( n n --> n )</
=={{header|R}}==
===R: With tutor===
<
double <- function(a) a*2
iseven <- function(a) (a%%2)==0
Line 4,415 ⟶ 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
Line 4,435 ⟶ 5,495:
print(ethiopicmult(17,34))
</syntaxhighlight>
=={{header|Racket}}==
<
(define (halve i) (quotient i 2))
Line 4,449 ⟶ 5,509:
[else (+ y (ethiopian-multiply (halve x) (double y)))]))
(ethiopian-multiply 17 34) ; -> 578</
=={{header|Raku}}==
(formerly Perl 6)
<syntaxhighlight lang="raku"
sub double (Int $n is rw) { $n *= 2 }
sub even (Int $n --> Bool) { $n %% 2 }
Line 4,467 ⟶ 5,527:
}
say ethiopic-mult(17,34);</
{{out}}
578
More succinctly using implicit typing, primed lambdas, and an infinite loop:
<syntaxhighlight lang="raku"
my &halve = * div= 2;
my &double = * *= 2;
Line 4,485 ⟶ 5,545:
}
say ethiopic-mult(17,34);</
More succinctly still, using a pure functional approach (reductions, mappings, lazy infinite sequences):
<syntaxhighlight lang="raku"
sub double { $^n * 2 }
sub even { $^n %% 2 }
Line 4,497 ⟶ 5,557:
}
say ethiopic-mult(17,34);</
=={{header|Rascal}}==
<
public int halve(int n) = n/2;
Line 4,517 ⟶ 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)
Line 4,546 ⟶ 5,633:
run ethiopian_mul(17,34)
print
</syntaxhighlight>
=={{header|REXX}}==
These two REXX versions properly handle negative integers.
===sans error checking===
<
numeric digits 3000 /*handle some gihugeic integers. */
parse arg a b . /*get two numbers from the command line*/
Line 4,570 ⟶ 5,657:
double: return arg(1) * 2 /* * is REXX's multiplication. */
halve: return arg(1) % 2 /* % " " integer division. */
isEven: return arg(1) // 2 == 0 /* // " " division remainder.*/</
'''output''' when the following input is used: <tt> 30 -7 </tt>
<pre>
Line 4,582 ⟶ 5,669:
Note that the 2<sup>nd</sup> number needn't be an integer, any valid number will work.
<
numeric digits 3000 /*handle some gihugeic integers. */
parse arg a b _ . /*get two numbers from the command line*/
Line 4,609 ⟶ 5,696:
halve: return arg(1) % 2 /* % " " integer division. */
isEven: return arg(1) // 2 == 0 /* // " " division remainder.*/
error: say '***error!***' arg(1); exit 13 /*display an error message to terminal.*/</
'''output''' when the following input is used: <tt> 200 0.333 </tt>
<pre>
Line 4,618 ⟶ 5,705:
=={{header|Ring}}==
<
x = 17
y = 34
Line 4,637 ⟶ 5,724:
func halve n return floor(n / 2)
func even n return ((n & 1) = 0)
</syntaxhighlight>
Output:
<pre>
Line 4,648 ⟶ 5,735:
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 4,676 ⟶ 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 4,688 ⟶ 5,808:
A test suite:
<
class EthiopianTests < Test::Unit::TestCase
def test_iter1; assert_equal(578, ethopian_multiply(17,34)); end
Line 4,702 ⟶ 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 4,716 ⟶ 5,836:
=={{header|Rust}}==
<
2*a
}
Line 4,750 ⟶ 5,870:
println!("---------------------------------");
println!("\t {}", output);
}</
{{out}}
Line 4,762 ⟶ 5,882:
=={{header|S-BASIC}}==
<
$constant true = 0FFFFH
$constant false = 0
Line 4,807 ⟶ 5,927:
print ethiopian(17,34,true)
end</
{{out}}
<pre>Multiplying 17 times 34
Line 4,823 ⟶ 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 4,850 ⟶ 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 4,869 ⟶ 5,989:
(display (mul-eth 17 34))
(newline)</
Output:
578
Line 4,876 ⟶ 5,996:
Ethiopian Multiplication is another name for the peasant multiplication:
<
begin
a *:= 2;
Line 4,900 ⟶ 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}}==
<
func halve (n) { n >> 1 }
func isEven (n) { n&1 == 0 }
Line 4,919 ⟶ 6,039:
}
say ethiopian_mult(17, 34)</
{{out}}
<pre>
Line 4,927 ⟶ 6,047:
=={{header|Smalltalk}}==
{{works with|GNU Smalltalk}}
<
double [ ^ self * 2 ]
halve [ ^ self // 2 ]
Line 4,958 ⟶ 6,078:
]
ethiopianMultiplyBy: aNumber [ ^ self ethiopianMultiplyBy: aNumber withTutor: false ]
].</
<
=={{header|SNOBOL4}}==
<
define('halve(num)') :(halve_end)
halve eq(num,1) :s(freturn)
Line 4,984 ⟶ 6,104:
l = halve(l) :s(next)
stop output = s
end</
=={{header|SNUSP}}==
<
| | /-\ /recurse\ #/?\ zero
$>,@/>,@/?\<=zero=!\?/<=print==!\@\>?!\@/<@\.!\-/
Line 4,998 ⟶ 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 5,066 ⟶ 6,186:
^answer <a>)
-->
(<r> ^multiply-done <a>)}</
=={{header|Swift}}==
<
func ethiopian(var #int1:Int, var #int2:Int) -> Int {
Line 5,094 ⟶ 6,214:
}
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 5,128 ⟶ 6,248:
}
return [expr {mult($a,$b)}]
}</
Ethiopian multiplication of 17 and 34
17 34 KEPT
Line 5,138 ⟶ 6,258:
=={{header|TUSCRIPT}}==
<
$$ MODE TUSCRIPT
ASK "insert number1", nr1=""
Line 5,184 ⟶ 6,304:
PRINT line
PRINT sum
</
ethopian multiplication of 17 and 34
17 34 kept
Line 5,193 ⟶ 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}}==
Line 5,198 ⟶ 6,362:
{{works with|Bourne Shell}}
<
{
expr "$1" / 2
Line 5,227 ⟶ 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 5,235 ⟶ 6,399:
{{works with|zsh}}
<
(( $1 >>= 1 ))
}
Line 5,262 ⟶ 6,426:
multiply 17 34
# => 578</
==={{header|C Shell}}===
<
alias double '@ \!:1 *= 2'
alias is_even '@ \!:1 = ! ( \!:2 % 2 )'
Line 5,286 ⟶ 6,450:
multiply p 17 34
echo $p
# => 578</
=={{header|Ursala}}==
Line 5,292 ⟶ 6,456:
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
Line 5,307 ⟶ 6,471:
# one to '''double an integer''', and
# one to '''state if an integer is even'''.
<
lngHalve = Nb / 2
End Function
Line 5,317 ⟶ 6,481:
Private Function IsEven(Nb As Long) As Boolean
IsEven = (Nb Mod 2 = 0)
End Function</
Use these functions to create a function that does Ethiopian multiplication.
The first function below is a non optimized function :
<
Dim Left_Hand_Column As New Collection, Right_Hand_Column As New Collection, i As Long, temp As Long
Line 5,349 ⟶ 6,513:
Next
Ethiopian_Multiplication_Non_Optimized = temp
End Function</
This one is better :
<
Do
If Not IsEven(First) Then Mult_Eth = Mult_Eth + Second
Line 5,358 ⟶ 6,522:
Loop While First >= 1
Ethiopian_Multiplication = Mult_Eth
End Function</
Then you can call one of these functions like this :
<
Dim result As Long
result = Ethiopian_Multiplication(17, 34)
Line 5,366 ⟶ 6,530:
'result = Ethiopian_Multiplication_Non_Optimized(17, 34)
Debug.Print result
End Sub</
=={{header|VBScript}}==
Line 5,375 ⟶ 6,539:
<code>option explicit</code> makes sure that all variables are declared.
'''Implementation'''<
class List
Line 5,464 ⟶ 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}}==
<
var double = Fn.new { |n| n * 2 }
Line 5,487 ⟶ 6,676:
System.print("17 x 34 = %(ethiopian.call(17, 34))")
System.print("99 x 99 = %(ethiopian.call(99, 99))")</
{{out}}
Line 5,497 ⟶ 6,686:
=={{header|x86 Assembly}}==
{{works with|nasm}}, linking with the C standard library and start code.
<
global main
Line 5,605 ⟶ 6,794:
db "struck", 0
kepttxt
db "kept", 0</
===Smaller version===
Using old style 16 bit registers created in debug
Line 5,618 ⟶ 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 5,649 ⟶ 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 5,695 ⟶ 6,884:
Product:= EthiopianMul(1234, 5678);
ChOut(0, 9); IntOut(0, Product); CrLf(0);
]</
<pre>17 34
8 0
Line 5,717 ⟶ 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 5,728 ⟶ 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 5,738 ⟶ 6,970:
68 68
0 0
</pre>
=={{header|Z80 Assembly}}==
<syntaxhighlight lang="z80"> org &8000
ld hl,17
call Halve_Until_1
push bc
ld hl,34
call Double_Until_1
pop bc
call SumOddEntries
;returns Ethiopian product in IX.
call NewLine
call Primm
byte "0x",0
push ix
pop hl
ld a,H
call ShowHex
;Output should be in decimal but hex is easier.
ld a,L
call ShowHex
ret
Halve_Until_1:
;input: HL = number you wish to halve. HL is unsigned.
ld de,Column_1
ld a,1
ld (Column_1),HL
inc de
inc de
loop_HalveUntil_1:
SRL H
RR L
inc b
push af
ld a,L
ld (de),a
inc de
ld a,H
ld (de),a
inc de
pop af
CP L
jr nz,loop_HalveUntil_1
;b tracks how many times to double the second factor.
ret
Double_Until_1:
;doubles second factor B times. B is calculated by Halve_until_1
ld de,Column_2
ld (Column_2),HL
inc de
inc de
loop_double_until_1:
SLA L
RL H
PUSH AF
LD A,L
LD (DE),A
INC DE
LD A,H
LD (DE),A
INC DE
POP AF
DJNZ loop_double_until_1
ret
SumOddEntries:
sla b ;double loop counter, this is also the offset to the "last" entry of
;each table
ld h,>Column_1
ld d,>Column_2 ;aligning the tables lets us get away with this.
ld l,b
ld e,b
ld ix,0
loop:
ld a,(hl)
rrca ;we only need the result of the odd/even test.
jr nc,skipEven
push hl
push de
ld a,(de)
ld L,a
inc de
ld a,(de)
ld H,a
ex de,hl
add ix,de
pop de
pop hl
skipEven:
dec de
dec de
dec hl
dec hl
djnz loop
ret ;ix should contain the answer
align 8 ;aligns Column_1 to the nearest 256 byte boundary. This makes offsetting easier.
Column_1:
ds 16,0
align 8 ;aligns Column_2 to the nearest 256 byte boundary. This makes offsetting easier.
Column_2:
ds 16,0</syntaxhighlight>
{{out}}
Output is in hex but is otherwise correct.
<pre>
0x0242
</pre>
=={{header|ZX Spectrum Basic}}==
{{trans|GW-BASIC}}
<
20 DEF FN h(a)=INT (a/2)
30 DEF FN d(a)=2*a
Line 5,751 ⟶ 7,105:
80 PRINT "---"
90 LET x=FN h(x): LET y=FN d(y): GO TO 50
100 PRINT TAB (4);"===",TAB (4);tot</
[[Category:Arithmetic]]
|