Periodic Strings

[Antoni Gual]

My results: The program fails with the trivial case of order 11, where all the figures in the series are ones, the result should be period 1 starting at 1

Code:

Result for order  2 : Periodicity starts at      1 period is    10

Result for order  3 : Periodicity starts at      1 period is    24

Result for order  4 : Periodicity starts at     26 period is    86

Result for order  5 : Periodicity starts at     41 period is   323

Result for order  6 : Periodicity starts at      1 period is     7

Result for order  7 : Periodicity starts at    455 period is   916

Result for order  8 : Periodicity starts at    328 period is   156

Result for order  9 : Periodicity starts at 11,606 period is  8689

Result for order 10 : Periodicity starts at     22 period is   624

Result for order 11 : Periodicity starts at      1 period is     2

Result for order 12 : Periodicity starts at     31 period is  4368

No periodicity found at order  13  with a buffer of size  32700

No periodicity found at order  14  with a buffer of size  32700

Result for order 15 : Periodicity starts at 13,751 period is 13840
results found in  17.2002  seconds

QB's strings seem to be enough for order 9, but are too short for order 13 and 14

the source for QB: uncommenting the right prints you can make it print the series...
My code checks if the last N figures in the string are found somewhere else
in the already genereted part. N is the order of the series. If N figures are duplicated somewhere, the figures following them are certainly the same...

Code:

'Entry series periodicity challenge in QBN
'Antoni Gual October 21 2005
'----------------------------------------------------------------
declare function subseries%(order%,length%)
declare function repfound%(sptr%,length%,order%)
defint a-z
const zero= 48
const ssz=32700  'maximum string size in QB!!!!
dim shared a$
a$= space$(ssz)
dim res,order,length,aa$
cls
t!=timer
for order= 2 to 15
'print:Print "Now checking order ";order

res= subseries(order,length)
'print:
print
if  res=0 then
   print "No periodicity found at order ";order;" with a buffer of size ";ssz
else
   print using "Result for order ## : Periodicity starts at #####, period is ##### "; order;res;length
   'print aa$
   'print mid$(a$,res,length)
end if
next
print "results found in ";timer-t!;" seconds"
sleep



function repfound(sptr,length,order)
  dim b$,p
  b$=mid$(a$,sptr-order+1,order)
  p=instr(a$,b$)
  'print left$(a$,sptr),b$,p,sptr
    
  if (p>0) and p<(sptr-order+1) then length=sptr-p-order+1 else p=0
  repfound=p
end function



function subseries(order,length)
dim i,b$,sptr,rf,nval

for i=1 to order
   mid$(a$,i)=chr$(zero+1)
   'print mid$(a$,i,1);
next
sptr=order
do
   nval=0
   for i=sptr-order+1 to sptr
      nval=nval+(asc(mid$(a$,i,1))-zero)
   next
   b$=ltrim$(str$(nval))
   'print b$;
   mid$(a$,sptr+1,len(b$))=b$  
   sptr=sptr+len(b$)
    'print left(a$,sptr)
    rf=repfound (sptr,length,order)
    if rf then exit do
loop until sptr>=ssz-order-4
subseries=rf
end function

EDITED: Freebasic, with a buffer of 3,7 Mchars, says order 13 has a period of 115552, starting at position 5712...