Squares

General FreeBASIC programming questions.
Locked
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Squares

Post by Tourist Trap »

Challenge related to multwise string reversal for well irrigated brains:)
===》Now that we made some step forward in the previous posts: can we prove that , granted a base at least equal to 27 (numbers coded with alphabetical chars from A to Z, and <space>), we can find such a base that every sentence made with the symbols of this base (embedding the alphabet, A=value... B=othervalue etc...) could be reversed multwise?

Said differently, for some base big enough to embed the alphabet as a part of the one-digit numbers of the base (and space), is there then a probability of 1 that we can find a one-digit multiplier that will effectively reverse any number shaped as a sentence?

For instance (fake), in base 3000, with a subset of the one-digit numbers of this base (A=1000, B=1900, etc.. granted that we can choose our values between 0 and 2999 in base 3000), we could imagine that a multiplier k will operate like this:
k*(HELLO WORLD) = DLROW OLLEH

What do you think of this? Can we at least evaluate what lower bound would be necessary to reach for a base where such a thing occures very often (probability close to 1)?
dodicat
Posts: 7979
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Post by dodicat »

Here is an extension of your previous bases.

Code: Select all

base        multipliers
 3             2
 4             3
 5             2 4
 6             2 5
 7             3 6
 8             2 3 5 7
 9             2 4 8
 10            4 9
 11            2 3 5 7 10
 12            2 3 5 11
 13            5 6 12
 14            2 4 6 13
 15            2 3 4 7 11 14
 16            3 7 15
 17            2 4 5 8 10 11 16
 18            2 5 8 17
 19            3 4 6 7 9 18
 20            2 3 4 6 9 19
 21            2 5 6 10 13 20
 22            10 21
 23            2 3 4 5 7 11 13 15 17 22
 24            2 3 4 5 7 11 19 23
 25            4 9 12 24
 26            2 8 10 11 12 25
 27            2 3 6 8 13 26
 28            3 6 13 27
 29            2 4 5 8 9 14 16 19 28
 30            2 4 5 9 14 29
 31            3 7 10 11 15 30
 32            2 3 4 5 7 10 15 31
 33            2 10 16 32
 34            4 6 13 16 33
 35            2 3 4 5 6 8 11 17 19 23 26 29 34
 36            2 3 5 8 11 17 35
 37            5 13 18 21 22 36
 38            2 4 7 10 12 14 18 27 37
 39            2 3 4 5 6 7 9 11 12 14 16 17 19 31 38
 40            3 4 7 9 19 39
 41            2 5 6 8 9 11 13 16 17 20 22 27 40
 42            2 5 6 13 20 41
 43            3 7 9 10 12 15 19 21 25 42
 44            2 3 4 6 8 10 14 21 43
 45            2 4 5 8 14 22 44
 46            7 11 22 45
 47            2 3 4 5 7 9 11 13 15 23 25 31 35 46
 48            2 3 5 6 7 11 13 15 23 41 47
 49            4 6 9 17 19 24 48
 50            2 4 8 9 16 18 24 49
Press any key to continue . . . 
Here is the code (It is Very slow)

Code: Select all

#define irange(f,l) int(Rnd*((l+1)-(f))+(f))

Function polyeval(Coefficients() As Double,Byval x As Double) As Double
    Dim As Double acc
    For i As Long=Ubound(Coefficients) To Lbound(Coefficients) Step -1
        acc=acc*x+Coefficients(i)
    Next i
    Return acc
End Function

function notinarray(a() as double,n as double) as long
    for m as long=lbound(a) to ubound(a)
        if a(m)=n then return 0
    next
    return -1
end function

sub bsort(a() as double)
    for n1 as long=lbound(a) to ubound(a)-1
        for n2 as long=n1+1 to ubound(a)
            if a(n1)>a(n2) then swap a(n1),a(n2)
        next
    next
    end sub

#macro reverse(s)
For n As long=Lbound(s) To Int((Lbound(s)+Ubound(s))/2):Swap s(n),s(Ubound(s)+Lbound(s)-n):Next
#endmacro

dim as double p(1 to 4)
dim as double m


for z as double=3 to 50
   dim as long count 
redim as double a(1 to 1)
a(1)=z-1

do
    
do
    
for n as long=lbound(p) to ubound(p)
    p(n)=irange(0,(z-1))
next
loop until p(lbound(p))<>0 and p(ubound(p))<>0

var V1=polyeval(p(),z)
reverse(p)
var V2=polyeval(p(),z)
 m=v1/v2
if m<>1 and m then
    
if m=int(m) then 

    if notinarray(a(),m) then
        redim preserve a(1 to ubound(a)+1)
        a(ubound(a))=m
    end if
    
end if
end if
count+=1
loop until len(inkey) or count>10000*z*z
bsort(a())
print z,
for n as long=lbound(a) to ubound(a)
    print a(n);
next
print

next z
sleep
 
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Squares

Post by Tourist Trap »

dodicat wrote:Here is an extension of your previous bases.
Thanks.

It seems that sometimes we havent any numbers reversed below the value base^4, but the failure never goes beyong base^4. Does this generalize to any base as big as we want it to be?

Note: base 0, base 1, base infinite, has no multwise reversal. The infinite base would lead to a list of unique one-digit numbers, so whatever you multiply there it's some different one-digit number that is obtained. So our game stands somewhere between the base 1, and the infinite base.
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

Heres some code for your ( reversal * num ) = num ^ 2

Code: Select all


screen 19

dim as longint value = 10
do
    
    dim as string num1 = str(value)
    dim as string num2
    
    for a as longint = len(num1) to 1 step -1
        num2+= mid(num1,a,1)
    next
    
    dim as longint val1=0
    do
        val1+=1
    loop until valulng(num2) * val1 >= valulng(num1)^2
    
    if valulng(num1)^2 = valulng(num2) * val1 then
        print
        print num1 , valulng(num1) ^ 2 
        print num2 , valulng(num2) * val1 , val1
        sleep
    end if
    
    if inkey= chr(27) then exit do
        
    value+=1
    
loop

sleep
end

albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

Hello ,
its been awhile ,
still pondering my multiplier, not ready to write the code yet..


How do you find the diameter of a circle, knowing only the circumference?
Richard
Posts: 3096
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Post by Richard »

Circumference = Pi * Diameter
Diameter = Circumference / Pi
dodicat
Posts: 7979
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Post by dodicat »

Hi Albert.
I thought that you had emigrated.
I think Circles should be re-opened, all the answers are there.
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

Thanks Richard!!

I was wanting to know how wide a 40oz. beer bottle was, the bottom of the bottle has a curve , so the bottom is not as wide as the sides are.
And if you draw a cricle around the bottle , the 1/2 width of the pencil or pen adds to the diameter.


HI DODDICAT!!!! I'll have my new multiplier ready in a couple weeks.
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@Dodicat

I was doing geneology research and looked under Scottish heraldry and couldn't find Redditt
I went on to British heraldry and it says Redditt's are crested Highlanders.

Are the Highlands not part of Scottland??

I saw a Scottish Heraldry book in the library that said that Reddy's or Reddi's are a sub clan of clan Brown?

Clan Adams has a big number in Santa Barbara California here, there's about 1-1/2 to 2 phone book pages of Adams'
srvaldez
Posts: 3374
Joined: Sep 25, 2005 21:54

Re: Squares

Post by srvaldez »

hello albert, Richard and dodicat
found and interesting read, The Bakhshali square root http://www.davidhbailey.com/dhbpapers/india-sqrt.pdf
might be interesting to implement in fb
dodicat
Posts: 7979
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Post by dodicat »

Hi Albert.
The Highlands form the Northern part.
The Central lowlands, the middle, (Glasgow to Edinburgh)'
And my own part, the Southern Uplands, a bit like the highlands.

To be honest, clans are a kinda nostalgic thing for those who are a bit homesick.
If we see a kilted man he is more than likely a tourist or an Englishman hanging on to some notion of clansmanship.
However, the ladies would wear tartan if it is in fashion.
Redditt is an uncommon name in these parts.
We might wear some sort of kilt/tartan at a wedding or something, but these things would be hired.
I think the people who would actually have their clan tartan in their wardrobe would be in a pipe band or some other group, or an Englishman.

But saying all that, if the old Jacobites arose again, I would probably sign up.
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@Dodicat

Redditt's are a sub clan of Reddy , Reddy's come from India and Kashmir , and settled into Scandinavia and were chased across the English channel by the Romans in the year 800. My ancestors change the name and added 2 T's

So now its spelled "ready" with 2 d's and 2 t's
tuddi's and tutti's ( In Italian tutti means = "tie hang (bat) , tie tie many (make a tie many times) " = to beat a person up with a bat)
Like "Tutti Fruiti" means to smash the fruit..
dafhi
Posts: 1641
Joined: Jun 04, 2005 9:51

Re: Squares

Post by dafhi »

2017 Oct 6 - quicksort update

Code: Select all

Type vector3d
  As double         x,y,z
  as uinteger       color
End Type

Type MySortType as vector3d

Const               DataLen = 5 * 1000

' =========================================

sub RandomData(a() as MySortType)
  dim as integer ub = ubound(a)
  for i as integer = 0 to ub
    a(i).z = int(rnd*6)
    a(i).z = rnd
  Next
End Sub

function Sorted(a() as MySortType) as uinteger
  dim as double b = a(0).z
  for p as MySortType ptr = @a(1) to @a(ubound(a))
    if b > p->z then return FALSE
    b = p->z
  Next: return TRUE
end function

type tTimings
  as long           ub = -1
  as double         a(any)
  as string         mesg
  declare operator  cast as string
  declare operator  cast as double
  declare operator  cast as single
End Type
operator tTimings.cast as string:  return str(a(ub/2))
End Operator
operator tTimings.cast as double:  return a(ub/2)
End Operator
operator tTimings.cast as single:  return a(ub/2)
End Operator


dim shared as long    ub_times = 12
dim shared as double  times(ub_times)

'timer values
sub InsertionSort_Dbl(A() As double,UB As integer=-1,LB As integer=0)
  if lb>ub then lb=lbound(a): ub=ubound(a)
  var lo=lb: for i as integer=lb+1 to ub: if a(i) < a(lo) then lo=i
  next: swap a(lb), a(lo)
  For i as integer=lb+1 To ub-1
    dim as integer j=i+1: if a(j) < a(i) then
      dim as double sw=a(j): j=i: while sw < a(j)
        a(j+1)=a(j): j-=1: wend: a(j+1)=sw: endif: Next
End Sub

#Macro mac_timer(algo,ret)
  for i as integer = 0 to ub_times
    RandomData a()
    dim as double t = timer
      algo
    times(i) = timer - t
    If not Sorted( a() ) then ? "sort error! "; ret.mesg
  Next: InsertionSort_Dbl times()
  ret.ub+=1
  redim preserve ret.a(ret.ub)
  ret.a(ret.ub) = times(ub_times/2)
  InsertionSort_Dbl ret.a()
#EndMacro

' ==========================

'<><><><><><><><><><><> Quick SORT <><><><><><><><><><> 'dodicat's quicksort
#macro SetQsort(datatype,fname,b1,b2,dot)
    Sub fname(array() As datatype,begin As Long,Finish As Ulong)
    Dim As Long i=begin,j=finish
    Dim As datatype x =array((I+J)\2)
    While I <= J:While array(I)dot b1 X dot:I+=1:Wend
        While array(J)dot b2 X dot:J-=1:Wend
                If I<=J Then Swap array(I),array(J): I+=1:J-=1
    Wend:If J > begin Then fname(array(),begin,J)
    If I < Finish Then fname(array(),I,Finish)
    End Sub
#endmacro
'<><><><><><><><><><><><><><><><><><><><><><>

'<><><><><><><><><><><><><><><><><><><><><><> 'my new quicksort, dodicats macro
#macro set_sort(datatype,fname,b1,b2,dot)
sub fname(a() as datatype, ub as long=0, lb as long=0) '2017 Oct 6
  #macro sw(x,y)
    if a(x)dot b2 a(y)dot then: swap a(x),a(y): endif
  #EndMacro
  'Based upon a youtube quicksort Z5nSXTnD1I4 ..
  'First element is the pivot
  var j=(lb+ub)\2
  sw(j,ub):  if lb>=ub-1 then exit sub      '2017 Oct 6
  sw(j,lb)
  sw(lb,ub) 'After 3 swaps:  [mid][lo][hi]
  if lb<ub-1 then                           '2017 Oct 4
    j=ub: var i=lb
    while i<j
      j-=1                                  '2017 Oct 6
      while a(j)dot b2 a(lb)dot: j-=1: wend
      i+=1
      while a(i)dot b1 a(lb)dot: i+=1: wend
      if j<=i then i=j: exit while
      sw(i,j)
      'j-=1                                 '2017 Oct 6
    Wend
    sw(lb,j)
    i-=1: if lb<i then fname a(), i,lb
    j+=1: if j<ub then fname a(), ub,j
  endif
End Sub
#endmacro
'<><><><><><><><><><><><><><><><><><><><><><>

#define up <,>
#define down >,<

'        udt  name  dirn field
set_sort(MySortType,qs2,up,.z)
setQsort(MySortType,qsort,up,.z)

' ==================================

sub Main
  
  dim as integer    ub = DataLen - 1
  dim as MySortType a(ub)
  dim as tTimings   tA, tB

  sleep 250
  randomize
  
  #define sort_a mac_timer( qs2( a(),ubound(a) ), tA )
  #define sort_b mac_timer( qsort( a(),0,ubound(a) ), tB )

  ? " sorting .."

  tA.mesg = "qsort2 "
  tB.mesg = "qsort  "
  for i as long = 1 to 40
    sleep 1
    if rnd<.5 then 'algorithm sequence can make a difference
      sort_a
      sort_b
    else
      sort_b
      sort_a
    endif
  next
  cls: ?: ?: ?
  ? tA.mesg; tA
  ? tB.mesg; tB
  ?: ?
  ? " ratio:  (smaller is better)": ?
  if tA<tB then
    ? tA.mesg; tA / tB
  else
    ? tB.mesg; tB / tA
  EndIf

  sleep
end sub


Main
Last edited by dafhi on Oct 26, 2017 13:30, edited 13 times in total.
dodicat
Posts: 7979
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Post by dodicat »

Hi dafhi
I get about the same speed on optimized gcc 64 and 32 bit.(gcc, I only use for testing)
With gas I get qsort a bit faster.
dafhi
Posts: 1641
Joined: Jun 04, 2005 9:51

Re: Squares

Post by dafhi »

just getting a qsort to work is cause for celebration :)

reworking sort timer to see if i can optimize
Last edited by dafhi on Sep 21, 2017 13:29, edited 3 times in total.
Locked