## Squares

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

### Re: Squares

@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 19redim as string*2 values(1 to 65536)dim as string*2 valsdim as longint place = 1for a as longint = 0 to 255    for b as longint = 0 to 255        vals = chr(a) + chr(b)        values(place) = vals        place+=1    nextnextprint "done getting values"print "Zeroing duplicates"place = 0dim as string*2 pm1dim as string*2 pm2dim as longint val1dim as longint val2dim as double time1 , time2time1 = timerdo    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)-1print ubound(values) , placeprint "counting uniques and dups"dim as longint dups = 0dim as ulongint count = 0for a as longint = 1 to ubound(values)    if values(a)  = "" then dups+= 1    if values(a) <> "" then count+=1nextprint "65,536" ,  "unique = " ; count ; " dups = " ;dups ; " total = " ; count+dupsprint "length = " ; len(bin(count))sleepend`

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

Code: Select all

`screen 19redim as string*3 values(1 to 16777216)dim as string*3 valsdim as longint place = 1for 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 placenextprint "done getting values"print "Zeroing duplicates"place = 0dim as string*3 pm1dim as string*3 pm2dim as string*3 pm3dim as string*3 pm4dim as string*3 pm5dim as string*3 pm6dim as longint val1dim as longint val2dim as longint val3dim as longint val4dim as longint val5dim as longint val6dim as double time1 , time2time1 = timerdo    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)-1print ubound(values) , placeprint "counting uniques and dups"dim as longint dups = 0dim as ulongint count = 0for a as longint = 1 to ubound(values)    if values(a)  = "" then dups+= 1    if values(a) <> "" then count+=1nextprint "16,777,216" , "unique = " ; count , "dups = " ;dups , "total = " ; count+dupssleepend`
albert
Posts: 4391
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

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: 342
Joined: Sep 30, 2017 3:22

### Re: Squares

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

### Re: Squares

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

### Re: Squares

@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: 342
Joined: Sep 30, 2017 3:22

### Re: Squares

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

### Re: Squares

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          1total   =  256`
albert
Posts: 4391
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

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

### Re: Squares

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

### Re: Squares

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

### Re: Squares

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

### Re: Squares

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

### Re: Squares

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

### Re: Squares

Code: Select all

`' number of combinations of bits in a fixed number of cells up to 62. Dim As Integer i, n, bits, cells = 24Dim As Ulongint p, cPrint "no of   cells ="; cellsPrint "ones      combinations "p = 1Print 0, pc += pFor n = 1 To cells    p = p * ( cells - n + 1 ) \ n    Print n, p    c += pNext nPrintPrint "     total = ", cc = 1for n = 1 to cells    c = c * 2next n    Print " should be = ", cPrintPrint " done. "PrintSleep`
albert
Posts: 4391
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Richard

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