TheBackShed.com

Forum Index : Microcontroller and PC projects : MMBasic palindrome challenge

Author

Message

matherp
Guru

Joined: 11/12/2012
Location: United Kingdom
Posts: 10310

Posted: 11:58am 20 Sep 2021

Copy link to clipboard

Print this post

There is a fun thread on the Raspberry Pi Pico forum about finding all the numbers which are palindromes between 1 and 1,000,000 in both base10 and base2 and then adding the numbers that meet the criteria as quickly as possible (the answer is 872187).

How about some creative solutions in MMBasic? Let's see who has the fastest solution, obviously it will be platform dependent but we can run all of them on the CMM2 and see which is fastest.

My first try on the PicoMite is 72.1 seconds but that uses a sneaky CSUB which henceforth is deemed to break the rules.

Option default integer
Timer =0
Dim b$ length 6
Dim c$ length 6
Dim d$,e$
For i=1 To 999999
b$=Str$(i)
strrev b$,c$
If b$=c$ Then
d$=Bin$(i)
strrev d$,e$
If d$=e$ Then
Print b$,d$
Inc j,i
EndIf
EndIf
Next i
Print Timer/1000 " seconds. Total is ",j
End
CSub strrev
00000000
B085B480 6078AF00 687B6039 60BB781B B2DA68BB 701A683B 60FB2301 68BAE00D
1AD368FB 687A3301 6839441A 440B68FB 701A7812 330168FB 68BB60FB 68FA3301
D3EC429A BF00BF00 46BD3714 4770BC80
End CSub

Edited 2021-09-20 21:59 by matherp

vegipete

Guru

Joined: 29/01/2013
Location: Canada
Posts: 1132

Posted: 05:19pm 20 Sep 2021

Copy link to clipboard

Print this post

How long does the above program take if you add "step 2" to the end of line 6?
Edited 2021-09-21 03:20 by vegipete

Visit Vegipete's *Mite Library for cool programs.

JohnS
Guru

Joined: 18/11/2011
Location: United Kingdom
Posts: 4044

Posted: 05:30pm 20 Sep 2021

Copy link to clipboard

Print this post

vegipete said How long does the above program take if you add "step 2" to the end of line 6?

I'm wondering why?

(It'll miss some even numbers, I suspect. hmm, can a binary number ending in 0 fit the definition? I don't know...)

edit: looks like "no" is the answer, so skipping even numbers looks ok.

John
Edited 2021-09-21 03:34 by JohnS

matherp
Guru

Joined: 11/12/2012
Location: United Kingdom
Posts: 10310

Posted: 05:37pm 20 Sep 2021

Copy link to clipboard

Print this post

Quote can a binary number ending in 0 fit the definition?

No: because numbers don't have leading zeroes. Clever man is vegipete

Answer, obviously, is that it halves the time

Volhout
Guru

Joined: 05/03/2018
Location: Netherlands
Posts: 5089

Posted: 09:20am 21 Sep 2021

Copy link to clipboard

Print this post

If only odd numbers meet the criteria, then there are maximum 500000 of them in
1-999999 range.
The answer however seems to be 872187

So there must be even numbers that meet the criteria.

Regards,

Volhout

PicomiteVGA PETSCII ROBOTS

JohnS
Guru

Joined: 18/11/2011
Location: United Kingdom
Posts: 4044

Posted: 10:56am 21 Sep 2021

Copy link to clipboard

Print this post

I gather the numbers meeting the criteria are summed.

John

Volhout
Guru

Joined: 05/03/2018
Location: Netherlands
Posts: 5089

Posted: 11:56am 21 Sep 2021

Copy link to clipboard

Print this post

Ah...that makes sense...

I was confused thinking Inc j,i would increment both j and i, but it is a j=j+i
Simply confused...
Edited 2021-09-22 00:23 by Volhout

PicomiteVGA PETSCII ROBOTS

Volhout
Guru

Joined: 05/03/2018
Location: Netherlands
Posts: 5089

Posted: 03:39pm 21 Sep 2021

Copy link to clipboard

Print this post

Unless I did something wrong..... but the sum at the end is right.

31 miliseconds on MMbasic for DOS on an i9 laptop.

'palindrome numbers are symetrical. in base 10 they should have the form abccba from numbers under 1e6.
'in base 2 they cannot end in a zero, becuase the first bit cannot be zero. This limits to odd numbers.
'in base 10 you will have to ripple through abccba and abcba and abba and aba and aa and a

Timer = 0
Total = 0

'6 digits
For a=1 To 9 Step 2
k=a*100001
For b=0 To 9
l=b*10010
For c=0 To 9
x=c*1100+l+k
bincheck
Next c,b,a

'5 digits
For a=1 To 9 Step 2
k=a*10001
For b=0 To 9
l=b*1010
For c=0 To 9
x=c*100+l+k
bincheck
Next c,b,a

'4 digits
For a=1 To 9 Step 2
k=a*1001
For b=0 To 9
x=b*110+k
bincheck
Next b,a

'3 digits
For a=1 To 9 Step 2
k=a*101
For b=0 To 9
x=b*10+k
bincheck
Next b,a

'2 digits
For a=1 To 9 Step 2
x=a*11
bincheck
Next a

'1 digits, these are all symetrical (b1,b11,b101,b111,b1001)
For x=1 To 9 Step 2
Total = Total + x
Next x

Print Timer
Print Total

' checking the binary string for symmetry
' the lsb is always 1 (odd), the msb is always 1 (never start with 0)
' so we only check the other digits
' for strings with an odd length we do not test the center bit.
Sub bincheck
y$=Bin$(x) : w=Len(y$) : z=Int(w/2)
'Print y$,z,w
pali=0
For i=2 To z
'Print Mid$(y$,i,1),Mid$(y$,w+1-i,1)
If Mid$(y$,i,1)=Mid$(y$,w+1-i,1) Then
pali=pali+1
End If
Next i
If pali = z-1 Then
Total = Total + x
Print y$," pali"
End If
End Sub

Edited 2021-09-22 01:41 by Volhout

PicomiteVGA PETSCII ROBOTS

matherp
Guru

Joined: 11/12/2012
Location: United Kingdom
Posts: 10310

Posted: 03:54pm 21 Sep 2021

Copy link to clipboard

Print this post

Brilliant - that will take some beating 1.032 seconds on the PicoMite

UPDATE 0.888 seconds using AUTOSAVE C and OPTION DEFAULT INTEGER
Edited 2021-09-22 02:05 by matherp

thwill

Guru

Joined: 16/09/2019
Location: United Kingdom
Posts: 4311

Posted: 04:41pm 21 Sep 2021

Copy link to clipboard

Print this post

I haven't got time myself but someone might try using INC, removing the explicit variables from NEXT, unrolling some of the loops and replacing MID$ with PEEK calls.

Best wishes,

Tom
Edited 2021-09-22 02:45 by thwill

MMBasic for Linux, Game*Mite, CMM2 Welcome Tape, Creaky old text adventures

Volhout
Guru

Joined: 05/03/2018
Location: Netherlands
Posts: 5089

Posted: 05:12pm 21 Sep 2021

Copy link to clipboard

Print this post

Most of the gain is that you are only checking 1100 numbers, not a million.
But yes, there is some extra speed to gain.
Best is to optimize the 5 and 6 digit blocks since these contain 1000 of the 1100 numbers.
Edited 2021-09-22 03:14 by Volhout

PicomiteVGA PETSCII ROBOTS

jirsoft

Guru

Joined: 18/09/2020
Location: Czech Republic
Posts: 533

Posted: 05:23pm 21 Sep 2021

Copy link to clipboard

Print this post

CMM2, 504 MHz
0.36111 seconds. Total is 872187

OPTION DEFAULT NONE
OPTION EXPLICIT

TIMER = 0
DIM INTEGER i, j = 1, k, l, n
DIM STRING b, nb, nc, nd, d
FOR i = 1 TO 1024
b = BIN$(i)
nb = "&b" + b
nc = nb + "0"
nd = nb + "1"
FOR k = LEN(b) TO 1 STEP -1
CAT nb, MID$(b, k, 1)
CAT nc, MID$(b, k, 1)
CAT nd, MID$(b, k, 1)
NEXT k
'?nb, nc, nd
IF VAL(nb)<1000000 THEN
d = STR$(VAL(nb))
l = LEN(d)
n = 1
FOR k = 1 TO l\2
IF MID$(d, k, 1)<>MID$(d,l-k+1,1) THEN
n = 0
EXIT FOR
ENDIF
NEXT k
IF n THEN INC j, VAL(nb)
ENDIF
IF VAL(nc)<1000000 THEN
d = STR$(VAL(nc))
l = LEN(d)
n = 1
FOR k = 1 TO l\2
IF MID$(d, k, 1)<>MID$(d,l-k+1,1) THEN
n = 0
EXIT FOR
ENDIF
NEXT k
IF n THEN INC j, VAL(nc)
ENDIF
IF VAL(nd)<1000000 THEN
d = STR$(VAL(nd))
l = LEN(d)
n = 1
FOR k = 1 TO l\2
IF MID$(d, k, 1)<>MID$(d,l-k+1,1) THEN
n = 0
EXIT FOR
ENDIF
NEXT k
IF n THEN INC j, VAL(nd)
ENDIF
NEXT i
PRINT TIMER/1000 " seconds. Total is ", j

Edited 2021-09-22 03:23 by jirsoft

Jiri
Napoleon Commander and SimplEd for CMM2 (GitHub), CMM2.fun

matherp
Guru

Joined: 11/12/2012
Location: United Kingdom
Posts: 10310

Posted: 05:28pm 21 Sep 2021

Copy link to clipboard

Print this post

jirsoft's version takes 1.548 seconds on the Picomite

Here is volhout's code "hacked" for speed - now takes 0.745 seconds

Timer =0
GoTo start
bc:
y$=Bin$(x):w=Len(y$):z=w\2
p=0
For i=2 To z
If Peek(byte q+i)=Peek(byte q+w+1-i) Then
Inc p
EndIf
Next
If p = z-1 Then
Inc T,x
EndIf
Return
start:
Option DEFAULT INTEGER
Dim y$
Dim q=Peek(varaddr y$)
For a=100001 To 900009 Step 200002
For b=0 To 90090 Step 10010
x=b+a
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Next :Next
For a=10001 To 90009 Step 20002
For b=0 To 9090 Step 1010
x=b+a
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Next :Next
For a=1001 To 9009 Step 2002
For b=0 To 990 Step 110
x=b+a
GoSub bc
Next b,a
For a=101 To 909 Step 202
For b=0 To 90 Step 10
x=b+a
GoSub bc
Next :Next
For x=11 To 99 Step 22
GoSub bc
Next
For x=1 To 9 Step 2
Inc T,x
Next
Print Timer
Print T

Edited 2021-09-22 03:50 by matherp

vegipete

Guru

Joined: 29/01/2013
Location: Canada
Posts: 1132

Posted: 06:20pm 21 Sep 2021

Copy link to clipboard

Print this post

The bincheck routine should be changed to exit early as soon as the comparison is NOT equal. Then the second IF structure can be turfed.

Visit Vegipete's *Mite Library for cool programs.

Mixtel90

Guru

Joined: 05/10/2019
Location: United Kingdom
Posts: 7937

Posted: 07:39pm 21 Sep 2021

Copy link to clipboard

Print this post

Is that at stock CPU speed, Peter? No matter really, the PicoMite is still giving the rest quite a run for the money. :) 3.60 UKP? lol!

Mick

Zilog Inside! nascom.info for Nascom & Gemini
Preliminary MMBasic docs & my PCB designs

Volhout
Guru

Joined: 05/03/2018
Location: Netherlands
Posts: 5089

Posted: 07:49pm 21 Sep 2021

Copy link to clipboard

Print this post

@peter,

There is still one next b,a that can change into a next next.
The bincheck routine could be changed from counting matching bits, into dropping out at the first mismatch.

Volhout

PicomiteVGA PETSCII ROBOTS

matherp
Guru

Joined: 11/12/2012
Location: United Kingdom
Posts: 10310

Posted: 09:12pm 21 Sep 2021

Copy link to clipboard

Print this post

With early exit from the bc subroutine as suggested by vegipete 280 mSec

Timer =0
GoTo start
bc:
y$=Bin$(x):w=Len(y$):z=w\2
p=0
For i=2 To z
If Peek(byte q+i)=Peek(byte q+w+1-i) Then
Inc p
Else
Return
EndIf
Next
Inc T,x
Return
start:
Option DEFAULT INTEGER
Dim y$
Dim q=Peek(varaddr y$)
For a=100001 To 900009 Step 200002
For b=0 To 90090 Step 10010
x=b+a
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Next :Next
For a=10001 To 90009 Step 20002
For b=0 To 9090 Step 1010
x=b+a
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Next :Next
For a=1001 To 9009 Step 2002
For b=0 To 990 Step 110
x=b+a
GoSub bc
Next b,a
For a=101 To 909 Step 202
For b=0 To 90 Step 10
x=b+a
GoSub bc
Next :Next
For x=11 To 99 Step 22
GoSub bc
Next
For x=1 To 9 Step 2
Inc T,x
Next
Print Timer
Print T

With Volhout's magic and a little help from a different CSub 56.7mSec

CSub reverse
00000000
4B106800 401A0842 00404B0F 43024018 0893480E 480E4003 40020092 480D4313
4002091A 011B480C 431A4003 0B13BA12 D40304D2 085B2201 D0FC421A 2300600B
4770604B 55555555 AAAAAAAA 33333333 CCCCCCCC 0F0F0F0F F0F0F0F0
End CSub
Timer =0
Option DEFAULT INTEGER
Dim y$
Dim q=Peek(varaddr y$)
For a=100001 To 900009 Step 200002
For b=0 To 90090 Step 10010
x=b+a
reverse x,z
If x=z Then
Inc T,x
EndIf
Inc x,1100
reverse x,z
If x=z Then
Inc T,x
EndIf
Inc x,1100
reverse x,z
If x=z Then
Inc T,x
EndIf
Inc x,1100
reverse x,z
If x=z Then
Inc T,x
EndIf
Inc x,1100
reverse x,z
If x=z Then
Inc T,x
EndIf
Inc x,1100
reverse x,z
If x=z Then
Inc T,x
EndIf
Inc x,1100
reverse x,z
If x=z Then
Inc T,x
EndIf
Inc x,1100
reverse x,z
If x=z Then
Inc T,x
EndIf
Inc x,1100
reverse x,z
If x=z Then
Inc T,x
EndIf
Inc x,1100
reverse x,z
If x=z Then
Inc T,x
EndIf
Next :Next
For a=10001 To 90009 Step 20002
For b=0 To 9090 Step 1010
x=b+a
reverse x,z
If x=z Then
Inc T,x
EndIf
Inc x,100
reverse x,z
If x=z Then
Inc T,x
EndIf
Inc x,100
reverse x,z
If x=z Then
Inc T,x
EndIf
Inc x,100
reverse x,z
If x=z Then
Inc T,x
EndIf
Inc x,100
reverse x,z
If x=z Then
Inc T,x
EndIf
Inc x,100
reverse x,z
If x=z Then
Inc T,x
EndIf
Inc x,100
reverse x,z
If x=z Then
Inc T,x
EndIf
Inc x,100
reverse x,z
If x=z Then
Inc T,x
EndIf
Inc x,100
reverse x,z
If x=z Then
Inc T,x
EndIf
Inc x,100
reverse x,z
If x=z Then
Inc T,x
EndIf
Next :Next
For a=1001 To 9009 Step 2002
For b=0 To 990 Step 110
x=b+a
reverse x,z
If x=z Then
Inc T,x
EndIf
Next b,a
For a=101 To 909 Step 202
For b=0 To 90 Step 10
x=b+a
reverse x,z
If x=z Then
Inc T,x
EndIf
Next :Next
For x=11 To 99 Step 22
reverse x,z
If x=z Then
Inc T,x
EndIf
Next
For x=1 To 9 Step 2
Inc T,x
Next
Print Timer
Print T

void reverse(long long int * in, long long int * out)
{
unsigned int x=*in;
x = ((x >> 1) & 0x55555555u) | ((x & 0x55555555u) << 1);
x = ((x >> 2) & 0x33333333u) | ((x & 0x33333333u) << 2);
x = ((x >> 4) & 0x0f0f0f0fu) | ((x & 0x0f0f0f0fu) << 4);
x = ((x >> 8) & 0x00ff00ffu) | ((x & 0x00ff00ffu) << 8);
x = ((x >> 16) & 0xffffu) | ((x & 0xffffu) << 16);
x>>=12;
while(!(x & 1))x>>=1;
*out = x;
}

Edited 2021-09-22 18:20 by matherp

Volhout
Guru

Joined: 05/03/2018
Location: Netherlands
Posts: 5089

Posted: 08:19am 22 Sep 2021

Copy link to clipboard

Print this post

@Peter,

The CSUB version:
- why do you still need "q" and y$ ??
- there is still a next b,a left
- you may gain a little if you represent all numbers as hexadecimal.
bin->hex conversion will be short, but it exists

Volhout
Edited 2021-09-22 18:25 by Volhout

PicomiteVGA PETSCII ROBOTS

matherp
Guru

Joined: 11/12/2012
Location: United Kingdom
Posts: 10310

Posted: 08:24am 22 Sep 2021

Copy link to clipboard

Print this post

I don't but I found a bit more in the Basic only version - now 260mSec

Timer =0
GoTo start
bc:
y$=Bin$(x):w=Len(y$):z=w\2
For i=2 To z
If Peek(byte q+i)<>Peek(byte q+w+1-i) Then Return
Next
Inc T,x
Return
start:
Option DEFAULT INTEGER
Dim y$
Dim q=Peek(varaddr y$)
For a=100001 To 900009 Step 200002
For b=0 To 90090 Step 10010
x=b+a
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Inc x,1100
GoSub bc
Next :Next
For a=10001 To 90009 Step 20002
For b=0 To 9090 Step 1010
x=b+a
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Next :Next
For a=1001 To 9009 Step 2002
For b=0 To 990 Step 110
x=b+a
GoSub bc
Next b,a
For a=101 To 909 Step 202
For b=0 To 90 Step 10
x=b+a
GoSub bc
Next :Next
For x=11 To 99 Step 22
GoSub bc
Next
For x=1 To 9 Step 2
Inc T,x
Next
Print Timer
Print T

Volhout
Guru

Joined: 05/03/2018
Location: Netherlands
Posts: 5089

Posted: 08:44am 22 Sep 2021

Copy link to clipboard

Print this post

bit faster, changing other constants to hex does not add additional speed.
523.4ms picomite 125MHz, shortening the string "start" to "st" gained 2 ms
The single digit loop can be removed..

Timer =0
GoTo st
bc:
y$=Bin$(x):w=Len(y$):z=w\2
For i=2 To z
If Peek(byte q+i)<>Peek(byte q+w+1-i) Then Return
Next
Inc T,x
Return
st:
Option DEFAULT INTEGER
Dim y$
Dim q=Peek(varaddr y$)
For a=100001 To 900009 Step 200002
For b=0 To 90090 Step 10010
x=b+a
GoSub bc
Inc x,&h44c
GoSub bc
Inc x,&h44c
GoSub bc
Inc x,&h44c
GoSub bc
Inc x,&h44c
GoSub bc
Inc x,&h44c
GoSub bc
Inc x,&h44c
GoSub bc
Inc x,&h44c
GoSub bc
Inc x,&h44c
GoSub bc
Inc x,&h44c
GoSub bc
Next :Next
For a=10001 To 90009 Step 20002
For b=0 To 9090 Step 1010
x=b+a
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Inc x,100
GoSub bc
Next :Next
For a=1001 To 9009 Step 2002
For b=0 To 990 Step 110
x=b+a
GoSub bc
Next :Next
For a=101 To 909 Step 202
For b=0 To 90 Step 10
x=b+a
GoSub bc
Next :Next
For x=11 To 99 Step 22
GoSub bc
Next
Inc T,(1+3+5+7+9)
Print Timer
Print T

Edited 2021-09-22 19:03 by Volhout

PicomiteVGA PETSCII ROBOTS

Print this page

To reply to this topic, you need to log in.