June 2018 Update

This commit is contained in:
Ingy döt Net 2018-06-22 20:57:24 +00:00
parent ba8067c3b7
commit 22f33d4004
5278 changed files with 84726 additions and 14379 deletions

View file

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

View file

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

View file

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

View file

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

View file

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