Squares

General FreeBASIC programming questions.
albert
Posts: 4279
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 31, 2017 6:02

@sancho3

I got it optimized finally...
I preset the array and it fills it fast..

Then i convert the permutations to decimal and replace the decimal locations with "" (zero it out)

This code is for 0 to 65,536 (two bytes) , runs in a few seconds...

Code: Select all


screen 19

redim as string*2 values(1 to 65536)
dim as string*2 vals
dim as longint place = 1
for a as longint = 0 to 255
    for b as longint = 0 to 255
        vals = chr(a) + chr(b)
        values(place) = vals
        place+=1
    next
next
print "done getting values"


print "Zeroing duplicates"
place = 0
dim as string*2 pm1
dim as string*2 pm2

dim as longint val1
dim as longint val2

dim as double time1 , time2
time1 = timer
do
    place+=1
    do
        vals = values(place)
        if vals = "" then place+=1
    loop until vals <> ""
   
    pm1 = chr(vals[0]) + chr(vals[1])
    pm2 = chr(vals[1]) + chr(vals[0])
   
    val1 = val( "&B" + bin(asc( left(pm1,1))) + bin(asc(right(pm1,1))) )
    val2 = val( "&B" + bin(asc(right(pm2,1))) + bin(asc( left(pm2,1))) )
   
    if val1 <> place then values(val1) = ""
    if val2 <> place then values(val2) = ""
   
    time2 = timer
    if time2 - time1 > 10 then
        print ubound(values) , place
        sleep 10000
        time1 = timer
    end if
   
loop until place >= ubound(values)-1
print ubound(values) , place

print "counting uniques and dups"
dim as longint dups = 0
dim as ulongint count = 0
for a as longint = 1 to ubound(values)
    if values(a)  = "" then dups+= 1
    if values(a) <> "" then count+=1
next

print "65,536" ,  "unique = " ; count ; " dups = " ;dups ; " total = " ; count+dups
print "length = " ; len(bin(count))
sleep
end



This code is for 16,777,216 (three bytes) , takes about 20 minutes to run.

Code: Select all


screen 19

redim as string*3 values(1 to 16777216)
dim as string*3 vals
dim as longint place = 1
for a as longint = 0 to 255
    for b as longint = 0 to 255
        for c as longint = 0 to 255
            vals = chr(a) + chr(b) + chr(c)
            values(place) = vals
            place+=1
        next
    next
    print place
next
print "done getting values"


print "Zeroing duplicates"
place = 0
dim as string*3 pm1
dim as string*3 pm2
dim as string*3 pm3
dim as string*3 pm4
dim as string*3 pm5
dim as string*3 pm6

dim as longint val1
dim as longint val2
dim as longint val3
dim as longint val4
dim as longint val5
dim as longint val6

dim as double time1 , time2
time1 = timer
do
    place+=1
    do
        vals = values(place)
        if vals = "" then place+=1
    loop until vals <> ""
   
    pm1 = chr(vals[0]) + chr(vals[1]) + chr(vals[2])
    pm2 = chr(vals[0]) + chr(vals[2]) + chr(vals[1])
    pm3 = chr(vals[1]) + chr(vals[2]) + chr(vals[0])
    pm4 = chr(vals[1]) + chr(vals[0]) + chr(vals[2])
    pm5 = chr(vals[2]) + chr(vals[0]) + chr(vals[1])
    pm6 = chr(vals[2]) + chr(vals[1]) + chr(vals[0])
   
    val1 = val( "&B" + bin(asc(left(pm1,1))) + bin(asc(mid(pm1,2,1))) + bin(asc(right(pm1,1))) )
    val2 = val( "&B" + bin(asc(left(pm2,1))) + bin(asc(mid(pm2,2,1))) + bin(asc(right(pm2,1))) )
    val3 = val( "&B" + bin(asc(left(pm3,1))) + bin(asc(mid(pm3,2,1))) + bin(asc(right(pm3,1))) )
    val4 = val( "&B" + bin(asc(left(pm4,1))) + bin(asc(mid(pm4,2,1))) + bin(asc(right(pm4,1))) )
    val5 = val( "&B" + bin(asc(left(pm5,1))) + bin(asc(mid(pm5,2,1))) + bin(asc(right(pm5,1))) )
    val6 = val( "&B" + bin(asc(left(pm6,1))) + bin(asc(mid(pm6,2,1))) + bin(asc(right(pm6,1))) )
   
    if val1 <> place then values(val1) = ""
    if val2 <> place then values(val2) = ""
    if val3 <> place then values(val3) = ""
    if val4 <> place then values(val4) = ""
    if val5 <> place then values(val5) = ""
    if val6 <> place then values(val6) = ""
   
    time2 = timer
    if time2 - time1 > 10 then
        print ubound(values) , place
        sleep 10000
        time1 = timer
    end if
   
loop until place >= ubound(values)-1
print ubound(values) , place

print "counting uniques and dups"
dim as longint dups = 0
dim as ulongint count = 0
for a as longint = 1 to ubound(values)
    if values(a)  = "" then dups+= 1
    if values(a) <> "" then count+=1
next

print "16,777,216" , "unique = " ; count , "dups = " ;dups , "total = " ; count+dups

sleep
end

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

Re: Squares

Postby albert » Dec 31, 2017 19:27

It doesn't work...

In 16,777,216 elements , theres over 9,000,000 unique non-dups , (while checking for permutations.) ...(24 bits worth.)
Back to the drawing board..
sancho3
Posts: 284
Joined: Sep 30, 2017 3:22

Re: Squares

Postby sancho3 » Dec 31, 2017 19:34

I am having trouble understanding what a duplicate would be. Using the nested for loops you should never see the same set of values come up in order.
For example 255, 255, 255 will only ever appear once. And it is the same with all the sets 0,0 0 - 0,0,1 - 0,0,2 etc will only ever come up once.

Concerning 3 character string into an integer: You may run into a problem in that FB doesn't have a three byte variable. So if you push three bytes into an integer you are going to waste 1 full byte. That is a lot of wasted space. Then if you switch to 4 bytes you will suffer even longer processing times.
albert
Posts: 4279
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 01, 2018 1:07

@Sancho3

Hello;

3 bytes values have duplicates.. 0,0,0 doesn't have any permutations..
0,0,1 has 3 permutations = 0 0 1 , 0 1 0 , 1 0 0
1,2,3 has 6 permutations = 1 2 3 , 1 3 2 , 2 3 1 , 2 1 3 , 3 1 2 , 3 2 1

So in the 255 , 255 , 255 theres 24 - 1 bits of uniques.. The unique values come out to just over 9,000,000 , so theres like 7,000,000 duplicates or permutations..

So checking for permutations is a waste of time ,, cause its just short , of half the possible values.

if you do permutation checking on 8 bits. you would find that theres 128+ unique vales and 128- permutations, so the uniques still take 8 bits...
albert
Posts: 4279
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 01, 2018 1:50

@Richard

Do you have a permutation program to get all permutations of binary 8 bit values?
00000000 to 11111111

I want to see if i'm right about 128+ uniques and 128- permutations...
sancho3
Posts: 284
Joined: Sep 30, 2017 3:22

Re: Squares

Postby sancho3 » Jan 01, 2018 2:53

I am going to learn some math
Last edited by sancho3 on Jan 01, 2018 3:48, edited 2 times in total.
Richard
Posts: 2833
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Jan 01, 2018 3:11

Albert wrote:Do you have a permutation program to get all permutations of binary 8 bit values?
00000000 to 11111111
I want to see if i'm right about 128+ uniques and 128- permutations...

It depends on what you mean by permutations, which depends on why you need it.
There are 256 different arrangements of 8 bits.
You can arrange them by the number of bits set in the byte.

Code: Select all

ones   combinations
  0          1
  1          8
  2         28
  3         56
  4         70
  5         56
  6         28
  7          8
  8          1
total   =  256
albert
Posts: 4279
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 01, 2018 3:52

@Richard

I was wanting to get all the possible values of each binary value.

You got 0 to 255 ,
for a single bit theres 8 combos to cancel out.
for 2 bits there's , like you posted , 28 values to cancel out.

I wanted to know how many values "total" , would be canceled out by permutations...
I could just do a 8 nested loops , to check all possible values , and look for unique values to cancel out..

I thought you might be able to do it faster than what i was going to do..

Can you post a table like above for 16 bit values?
Richard
Posts: 2833
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Jan 01, 2018 5:48

Code: Select all

ones      combinations
 0             1
 1             16
 2             120
 3             560
 4             1820
 5             4368
 6             8008
 7             11440
 8             12870
 9             11440
 10            8008
 11            4368
 12            1820
 13            560
 14            120
 15            16
 16            1
  total =      65536
dodicat
Posts: 5152
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Jan 01, 2018 20:28

Hi Albert.
Here's a permutation algo.
I haven't made up one for combinations yet.

Code: Select all


    Sub Permutate(Byval s2 As String,perm() As String,OptionalStop As String="")
        Dim As Long p,i,j,result
        Redim perm(0)
        Dim As Long LENS2M1=Len(S2)-1
        Dim As Long lens2=Len(s2)
        Dim As Double factorial
        Dim temp As Double=1
        If Len(s2) >1 Then
            For n As Integer =1 To Len(s2)
                temp =temp * n
            Next
            factorial =temp
        Else
            factorial =1
        End If
        Redim perm(1 To (factorial))
        For p1 As Integer =0 To Len(s2)-2
            For p2 As Integer =p1 + 1 To Len(s2)-1
                If s2[p1]>s2[p2] Then Swap s2[p1],s2[p2]
            Next p2
        Next p1
        Do
            p=p+1
            perm(p)=s2
            If s2=OptionalStop Then Goto skip
            Do
                For i=Lens2-2 To 0 Step -1
                    If s2[i] <s2[i+1] Then Exit For
                Next
                If i <0 Then Result=0:Exit Do
                j =LENS2M1
                While s2[j] <= s2[i]: j -=1 : Wend
                Swap s2[i], s2[j]
                i +=1
                j =LENS2M1
                While i <j
                    Swap s2[i], s2[j]
                    i +=1
                    j -=1
                Wend
                result=-1:Exit Do
            Loop
        Loop Until result=0
        skip:
        Redim Preserve perm(1 To p)
    End Sub
   
    Redim Shared As String p()
   
    permutate(bin(2018),p())
print "Number to permute ";bin(2018)
print
   
    For z As Integer=Lbound(p) To Ubound(p)
        Print z,p(z)
        next
        Sleep
     
albert
Posts: 4279
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 01, 2018 22:45

@Dodicat

It closes down with error when you set it to an exponent of 2 , 2 , 4 , 8 , 16 , 32 , 64 , 128 , 256 , 512 , 1024, etc...

What i was trying to do if figure out all the possible permutations, and cancel them out.

But you need to put in how many bits and then a permutation number...
4 bits there's 70 permutation.. so it would take 3 bits to set the number of bits , bin(8) + bin(70) , it would be bigger than 255.

But it might come out smaller on 16 or 24 bits??? What do you think about it?
dodicat
Posts: 5152
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Jan 01, 2018 23:36

Albert.
I am not really sure what you mean here with bits.
You say 4 bits 70 permutations?
I don't follow.
The permutator find the permutations of a sequence of characters.
Here is a faster one for binary strings or strings with many repeats.
It is slower for larger strings with unique characters.

Code: Select all

   
   
    Sub Permutate(byval s2 As String,perm() as string,OptionalStop as string="")
    Dim As Integer p,i,j,result
    Redim perm(0)
    Dim As Long LENS2M1=Len(S2)-1
    Dim As Long lens2=Len(s2)
   
    For p1 As Integer =0 To lens2-2
        For p2 As Integer =p1 + 1 To LENS2M1
            If s2[p1]>s2[p2] Then Swap s2[p1],s2[p2]
        Next p2
    Next p1
    Do
        p=p+1
        redim preserve perm(1 to p)
        perm(p)=s2
        if s2=OptionalStop then goto skip
        Do
            For i=lens2-2 To 0 Step -1
                If s2[i] <s2[i+1] Then Exit For
            Next
            If i <0 Then Result=0:Exit Do
            j =LENS2M1
            While s2[j] <= s2[i]: j -=1 : Wend
            Swap s2[i], s2[j]
            i +=1
            j =LENS2M1
            While i <j
                Swap s2[i], s2[j]
                i +=1
                j -=1
            Wend
            result=-1:Exit Do
        Loop
    Loop Until result=0
    skip:
    Redim Preserve perm(1 To p)
End Sub
    Redim Shared As String p()
   
    permutate(bin(1024),p())
print "Number to permute ";bin(1024)
print
   
    For z As Integer=Lbound(p) To Ubound(p)
        Print z,p(z)
        next
        Sleep
     
albert
Posts: 4279
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 02, 2018 1:34

I got my data compressor working , i think..

I've been playing around with bit sizes..

I found that 12 bits , seems to get the shortest dictionaries , and most compression..
*.ZIP files have (BIT_SIZE - 2) different bits possible..So they can compress 2 bits per 12 bits..

The compressor requires 2 dictionaries , so it's an extra bit , to set the dictionary value.
Richard
Posts: 2833
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Jan 02, 2018 4:53

Code: Select all

' number of combinations of bits in a fixed number of cells up to 62.

Dim As Integer i, n, bits, cells = 24
Dim As Ulongint p, c
Print "no of   cells ="; cells
Print "ones      combinations "

p = 1
Print 0, p
c += p
For n = 1 To cells
    p = p * ( cells - n + 1 ) \ n
    Print n, p
    c += p
Next n

Print
Print "     total = ", c
c = 1
for n = 1 to cells
    c = c * 2
next n   
Print " should be = ", c
Print
Print " done. "
Print
Sleep
albert
Posts: 4279
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 02, 2018 21:21

@Richard

Thanks!!
I , played with it , and found that you can't compress , with the permutation cancellation trick...

Return to “General”

Who is online

Users browsing this forum: deltarho[1859], fxm, St_W and 4 guests