Squares

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

Re: Squares

Postby Tourist Trap » Aug 12, 2017 18:29

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: 4336
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Aug 12, 2017 21:34

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: 2197
Joined: Jun 02, 2015 16:24

Re: Squares

Postby Tourist Trap » Aug 13, 2017 11:03

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: 4024
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Aug 16, 2017 2:08

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: 4024
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Sep 14, 2017 16:19

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: 2753
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Sep 14, 2017 16:57

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

Re: Squares

Postby dodicat » Sep 14, 2017 21:41

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

Re: Squares

Postby albert » Sep 15, 2017 0:45

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: 4024
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Sep 17, 2017 0:58

@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: 1354
Joined: Sep 25, 2005 21:54

Re: Squares

Postby srvaldez » Sep 18, 2017 19:16

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: 4336
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Sep 18, 2017 23:51

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: 4024
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Sep 19, 2017 0:20

@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: 921
Joined: Jun 04, 2005 9:51

Re: Squares

Postby dafhi » Sep 19, 2017 6:35

2017 Oct 6 - quicksort update

Code: Select all

Const               DataLen = 5 * 1000

'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

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


Type MySortType as vector3d


sub RandomData(a() as MySortType)
  dim as integer ub = ubound(a)
  for i as integer = 0 to ub
    a(i).z = rnd
    'a(i).z = int(rnd*6)
  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)

#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 setsort(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
setsort(MySortType,yt2,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

  ? " sorting .."

  tA.mesg = "yt2   "
  tB.mesg = "qsort "
  for i as long = 1 to 40
    sleep 1
    if rnd<.5 then
    mac_timer( yt2( a(),ubound(a) ), tA )
    mac_timer( qsort( a(),0,ubound(a) ), tB )
    else
    mac_timer( qsort( a(),0,ubound(a) ), tB )
    mac_timer( yt2( a(),ubound(a) ), tA )
    endif
  next
  cls: ?: ?
  ? tA.mesg; tA
  ? tB.mesg; tB
  ?
  ? "ratio:"
  if tA<tB then
    ? tA.mesg; tA / tB
  else
    ? tB.mesg; tB / tA
  EndIf

  sleep
end sub

Main
Last edited by dafhi on Oct 07, 2017 4:15, edited 12 times in total.
dodicat
Posts: 4336
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Sep 19, 2017 15:54

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: 921
Joined: Jun 04, 2005 9:51

Re: Squares

Postby dafhi » Sep 19, 2017 20:11

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.

Return to “General”

Who is online

Users browsing this forum: Google [Bot] and 1 guest