U turn on Hamming method

[deltarho[1859]]

My friend's girlfriend introduced me to Chivas Regal. I hope dodicat isn't reading this because I preferred Jameson any day of the week.

This is what I drink now.
Yorkshire Tea 1

They have a sense of humour in Yorkshire.
Yorkshire Tea 2

Yorkshire Tea is OK but their finest is Yorkshire Gold.

I think I've drifted off-topic.

[dodicat]

A cuppa is nice, but I miss a cigarette. (doctor's orders)
Here is the U turn on the old shuffle, the anti shuffle:

Code: Select all

Sub shuffle(a As String)
    #define range(f,l) Int(Rnd*(((l)+1)-(f))+(f))
    For n As Long = 0 To Len(a)-2
        Swap a[n], a[range((n+1),Len(a)-1)]
    Next n
End Sub

Sub shuffleback(a As String)
    #define range(f,l) Int(Rnd*(((l)+1)-(f))+(f))
    Dim As String g
    Dim As Long L=Len(a)-2
    For n As Long = 0 To Len(a)-2 
        g=Str(range((n+1),Len(a)-1))+" "+g
    Next n
    For n As Long=0 To Len(a)-2
        Var v=Vallng(g)
        g=Ltrim(g,Str(v))
        g=Trim(g)
        Var k=L -n
        Swap a[k],a[v]
    Next n
End Sub


Dim As String s
s="O noon of life! O time to celebrate!"+Chr(13,10)
s+="O summer garden!"+Chr(13,10)
s+="Relentlessly happy and expectant, standing: -"+Chr(13,10)
s+="Watching all day and night, for friends I wait:"+Chr(13,10)
s+="Where are you, friends? Come! It is time! It's late!"+Chr(13,10)

Dim As String g=s

Print s
Print "----------------------------"
randomize
var n=int(rnd*10000)
Randomize n
shuffle(s)
Print s
Print "----------------------------"
Randomize n
shuffleback(s)
Print s
Print s=g

Sleep
 

There are probably faster U turns.

[deltarho[1859]]

Blimey, Friedrich Nietzsche no less.

Whilst not cryptographic a shuffle/shuffleback is a powerful obfuscation. One example is to input a password early in an application and shuffled and then shuffleback when needed. Quite a few other uses spring to mind.

Nice work dodicat. I have just put your procedures into my snippets file, which is now getting close to 1000 lines.

[dodicat]

Here is an update, very fast for longer strings:

Code: Select all

Sub shuffle(a As String)
    #define range(f,l) Int(Rnd*(((l)+1)-(f))+(f))
    dim as long L1=Len(a)-1
    For n As Long = 0 To Len(a)-2
        Swap a[n], a[range((n+1),L1)]
    Next n
End Sub

Sub shuffleback2(a As String)
    #define range(f,l) Int(Rnd*(((l)+1)-(f))+(f))
    Dim As Long L=Len(a)-2,L1=Len(a)-1
    redim as long ar(L)
    For n As Long = 0 To Len(a)-2
        ar(L-n)=(range((n+1),L1))
    Next n
    For n As Long=0 To Len(a)-2
        Swap a[L-n],a[ar(n)]
    Next n
End Sub

Dim As String s
s="O noon of life! O time to celebrate!"+Chr(13,10)
s+="O summer garden!"+Chr(13,10)
s+="Relentlessly happy and expectant, standing: -"+Chr(13,10)
s+="Watching all day and night, for friends I wait:"+Chr(13,10)
s+="Where are you, friends? Come! It is time! It's late!"+Chr(13,10)

Dim As String g=s

Print s
Print "----------------------------"
randomize
var n=int(rnd*10000)
Randomize n
shuffle(s)
Print s
Print "----------------------------"
Randomize n
shuffleback2(s)
Print s
Print s=g

Sleep

 

[deltarho[1859]]

@dodicat

My head has just hit the keyboard. I will have a look tomorrow.

[deltarho[1859]]

I have not looked at the first code, as it is much slower than the update.

Re Second code:

Minor adjustments

Just tidying up, but there is a boost to performance - 10% in the case of shuffleback2.

Len(a) is being repeatedly determined in both procedures and, ideally, should only be determined once.

Major adjustments

In shuffleback2 ar() effectively creates a look-up table for the second For/Next construct. It is remembering the random ranges calculated by shuffling. The random ranges were already calculated in the shuffle procedure, but their values were discarded, requiring the calculations to be repeated in the shuffleback2 procedure.

The look-up table is now created in the shuffle procedure, and ar() is renamed to RndRange. On entry to shuffle, RndRange is passed in as a null array and is passed out populated. The populated RndRange is passed in with shuffleback2. shuffleback2 has been renamed ReverseShuffle.

The code output is the same for both the minor and major adjustments compared with the original code.

shuffle will now be slower and shuffleback2 will now be faster.

Was it worth the effort?

I looked at a 1MB string of random characters.

The original code gave 0.030656s and 0.029087s for shuffle and shuffleback2 respectively.

The adjusted code gave 0.033805s and 0.002865s for shuffle and shuffleback2 respectively.

Surprisingly, shuffle has not slowed much, but shuffleback2 is over ten times faster.

The combined time for shuffling and reversing is about 38% faster with the adjusted code.

However, FreeBASIC is so fast that in absolute terms there is not a great deal in it.

And then someone comes in and says: "1MB - is that all - I'm dealing with 50MB strings here!". We have a different ball game now.

Of course, shuffle is no longer a classic shuffle, as we do not normally remember the random ranges calculated.

Code: Select all

Sub Shuffle( a As String, RndRange() As Long )
#define range(f,l) Int(Rnd*(((l)+1)-(f))+(f))
  Dim As long L = Len(a) - 2, L1 = L + 1
  For n As Long = 0 To L
    RndRange( L-n )=( range( (n+1), L1) )
    Swap a[n], a[RndRange( L - n )]
  Next n
End Sub
 
Sub ReverseShuffle( a As String, RndRange() As Long )
#define range(f,l) Int(Rnd*(((l)+1)-(f))+(f))
  Dim As Long L = Len(a) - 2, L1 = L + 1
  For n As Long = 0 To L
    Swap a[L-n], a[RndRange( n )]
  Next n
End Sub

[dodicat]

Thanks deltarho, I'Ill have a look at that.
Note that the limits in a for next loop are only evaluated once anyway.

Code: Select all

function limit(n as long) as long
    print __function__
    return n
end function

function start(n as long) as long
    print __function__
    return n
end function

for x as long=start(0) to limit(7)
    print x
next x
sleep

     

[deltarho[1859]]

@dodicat

In your code, Len(a) is evaluated twice in shuffle() and four times in shuffleback2().

In my code, Len(a) is only evaluated once per function.

[dodicat]

Thanks deltarho.
I don't think it will matter much here, but I'll tidy up a bit.
Here I save a 37 Mbyte file of shuffled characters, load it and re shuffle it all under 3 seconds.
I have automated the key (seed).

Code: Select all

Sub shuffle(a As String)
    #define range(f,l) Int(Rnd*(((l)+1)-(f))+(f))
    dim as long L1=Len(a)-1
    For n As Long = 0 To Len(a)-2
        Swap a[n], a[range((n+1),L1)]
    Next n
End Sub

Sub shuffleback(a As String)
    #define range(f,l) Int(Rnd*(((l)+1)-(f))+(f))
    Dim As Long L=Len(a)-2,L1=Len(a)-1
    redim as long ar(L)
    For n As Long = 0 To Len(a)-2
        ar(L-n)=(range((n+1),L1))
    Next n
    For n As Long=0 To Len(a)-2
        Swap a[L-n],a[ar(n)]
    Next n
End Sub


 #Include "file.bi"
sub savefile(filename As String,p As String)
    Dim As long n=freefile
    If Open (filename For Binary Access Write As #n)=0 Then
        Put #n,,p
        Close
    Else
        Print "Unable to save " + filename:sleep:end
    End If
End sub

Function loadfile(file as string) as String
   dim as long  f=freefile
   if Open (file For Binary Access Read As #f)=0 then
    Dim As String text
    If Lof(f) > 0 Then
      text = String(Lof(f), 0)
      Get #f, , text
    End If
    Close #f
    return text
 else:Print file;" not found":end if
end Function

sub saveshuffle(filename as string,content as string)
    var x=int(rnd*1000000)
randomize x
shuffle(content)
savefile(filename,str(x)+":"+content)
end sub

function getshuffleback(filename as string) as string
 var L=loadfile(filename)
var v=vallng(L)
L=mid(L,instr(L,":")+1)
randomize v
shuffleback(L)
return L
end function



randomize
var g="MARY JANE LUCY MARY PAM ALIX JANE "

for n as long=1 to 20
    g+=g
next n
var c=g 'copy to test
print
print left(g,72)+" . . . original, send to file shuffled"

dim as string filename="temp.dat"

dim as double t=timer
saveshuffle(filename,g)
print "file size ";filelen(filename)/1024/1024;" Mbytes"
print
print "start of file " 
print left(loadfile(filename),72)+" . . . e.t.c"
var ret=getshuffleback(filename)
print
print left(ret,72)+" . . . file shuffled back"
print "time taken ";timer-t
print cbool(ret=c)
kill(filename)
print cbool(fileexists(filename))
sleep

 

I suppose the shuffled file would be difficult to decipher, but maybe not.

[deltarho[1859]]

@dodicat

I will assume that you are still looking at my code because your last code is a follow on from your previous code as if I hadn't written any code. It could be that you simply missed the point that my shuffle reversing code is ten times faster than yours.

[dodicat]

I tested your code with the array before I posted.

Code: Select all

Sub shuffle_(a As String)
    #define range(f,l) Int(Rnd*(((l)+1)-(f))+(f))
    dim as long L1=Len(a)-1
    For n As Long = 0 To Len(a)-2
        Swap a[n], a[range((n+1),L1)]
    Next n
End Sub

Sub shuffleback_(a As String)
    #define range(f,l) Int(Rnd*(((l)+1)-(f))+(f))
    Dim As Long L=Len(a)-2,L1=Len(a)-1
    redim as long ar(L)
    For n As Long = 0 To Len(a)-2
        ar(L-n)=(range((n+1),L1))
    Next n
    For n As Long=0 To Len(a)-2
        Swap a[L-n],a[ar(n)]
    Next n
End Sub

Sub Shuffle( a As String, RndRange() As Long )
#define range(f,l) Int(Rnd*(((l)+1)-(f))+(f))
  Dim As long L = Len(a) - 2, L1 = L + 1
  redim rndrange(L)
  For n As Long = 0 To L
    RndRange( L-n )=( range( (n+1), L1) )
    Swap a[n], a[RndRange( L - n )]
  Next n
End Sub
 
Sub ReverseShuffle( a As String, RndRange() As Long )
#define range(f,l) Int(Rnd*(((l)+1)-(f))+(f))
  Dim As Long L = Len(a) - 2, L1 = L + 1
  For n As Long = 0 To L
    Swap a[L-n], a[RndRange( n )]
  Next n
End Sub

var g="MARY JANE LUCY MARY PAM ALIX JANE "

for n as long=1 to 15
    g+=g
next n
print "string length "; len(g)
print left(g,72)
dim as double t=timer
randomize 7
shuffle_(g)
print
print left(g,72)
randomize 7
shuffleback_(g)
print
print left(g,72)
print "time ";timer-t
print
print
print

redim as long rndrange()
t=timer
print "string length "; len(g)
print left(g,72)
 t=timer
shuffle(g,rndrange())
print
print left(g,72)
reverseshuffle(g,rndrange())
print
print left(g,72)
print "time ";timer-t
sleep
 

I couldn't think of an easy way to pass the array plus the shuffle to a file, but I am working on it.

[dodicat]

deltarho
Here is your method (saved and retrieved from file)
Your key is the deliminator between the sent array and sent string.
The saved file is quite large (array() + string)
The code is not modularized here, just step by step in the main program.

Code: Select all

 #Include "file.bi"
sub savefile(filename As String,p As String)
    Dim As long n=freefile
    If Open (filename For Binary Access Write As #n)=0 Then
        Put #n,,p
        Close
    Else
        Print "Unable to save " + filename:sleep:end
    End If
End sub

Function loadfile(file as string) as String
   dim as long  f=freefile
   if Open (file For Binary Access Read As #f)=0 then
    Dim As String text
    If Lof(f) > 0 Then
      text = String(Lof(f), 0)
      Get #f, , text
    End If
    Close #f
    return text
 else:Print file;" not found":end if
end Function

sub load(file as string,u() as long)
   var  f=freefile
   if fileexists(file)=0 then print file;"  not found":return
    Open file For Binary Access Read As #f
    If Lof(f) > 0 Then
      Get #f, ,u()
    End If
    Close #f
    end sub

sub save(file as string,u() as long)
    var h=freefile
    open file for binary access write as #h
    put #h, ,u()
    close #h
end sub

Sub ShuffleDR( a As String, RndRange() As Long )
#define range(f,l) Int(Rnd*(((l)+1)-(f))+(f))
  Dim As long L = Len(a) - 2, L1 = L + 1
  redim rndrange(L)
  For n As Long = 0 To L
    RndRange( L-n )=( range( (n+1), L1) )
    Swap a[n], a[RndRange( L - n )]
  Next n
End Sub
 
Sub ReverseShuffle( a As String, RndRange() As Long )
#define range(f,l) Int(Rnd*(((l)+1)-(f))+(f))
  Dim As Long L = Len(a) - 2, L1 = L + 1
  For n As Long = 0 To L
    Swap a[L-n], a[RndRange( n )]
  Next n
End Sub

function ap_pend(filename As String,txt As String) as string
    Dim As String s=loadfile(filename)
    If Len(s) Then savefile(filename,s+txt)
    return filename
End function

Sub split(s_in As String,char As String,result() As String)
    Dim As String s=s_in,var1,var2
    Dim As Long n=Lbound(result)-1,pst
    #macro splice(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
        var1=Mid(stri,1,pst-1)
        var2=Mid(stri,pst+Len(char))
    Else
        var1=stri
        Endif
        Redim Preserve result(Lbound(result) To 1+n-((Len(var1)>0)+(Len(var2)>0)))
        result(n+1)=var1
        #endmacro
        Do
            splice(s,char,var1,var2):n=n+1:s=var2
        Loop Until var2=""
        Redim Preserve result(Lbound(result) To Ubound(result)-1)
    End Sub
    

randomize
var g="MARY JANE LUCY MARY PAM ALIX JANE "

for n as long=1 to 20
    g+=g
next n
var c=g 'copy to test
print
print left(g,72)+" . . . original, send to file shuffled"

dim as string filename="temp.dat"
redim as long rr()
var key=chr(0,1,0,1,0,1,0,1)

dim as double t=timer

shuffleDR(g,rr())
save(filename,rr())'save the array first
ap_pend(filename,key+g)'add the shuffled string to the array, seperated by key
'==========================================

var L=loadfile(filename)'load everything back
redim as string s()
split(L,key,s())        'separate the array part from the string part
print 
print left(s(lbound(s)),72)+" . . . first few of the shuffled file"
print "size of file ";filelen(filename)/1024/1024;" Mbytes"

savefile("tmp",s(lbound(s)))'use a tmp file for this intermediate step (array part)
var sz=filelen("tmp")/sizeof(long)
redim as long rr2(sz-1)
load("tmp",rr2())'rr2() accepts the array part 
print 

ReverseShuffle(s(ubound(s)),rr2())'the shuffled string and array to be shuffled back
print left(s(ubound(s)),72)+" . . . file shuffled back"

print cbool(s(ubound(s))=c)
print "Time taken ";timer-t

kill(filename)
kill("tmp")
print cbool(fileexists("tmp")),cbool(fileexists(filename))

sleep

 

[deltarho[1859]]

Actually, RndRange was a bad choice of name - SwapLocations would have been better.

Another approach instead of having RndRange as a parameter would be to have it as a Shared array.

In ReverseShuffle there is no need for L1 now.

As you know I am not a fan of FB's RNGs so dropped in RomuTrio into shuffle and reverseshuffle. The time taken in your last but one code was nearly halved. I doubted that there would be much interest in shuffling large lists, but saw some questions at stackoverflow where some lists were huge.

If I may put my 'grumpy' hat on, shuffling should have been in another forum thread.

[dodicat]

Things should work in both methods with any good random generator.
So long as it can be seeded (for my method).
I didn't try my own generator for this.
I still say that at least one of the fb generators should return the ulong and not a double obtained by a division inside the generator.
Preferably the twister one.
Anyway, I'll get back to basiccoder2's blobs, I have been putting it off.

[deltarho[1859]]

My RndMT, which replaces FB's #3 BASIC engine with asm and runs much faster, populates the whole of the state vector and may return a Ulong in addition to a float in [0,1). However, my later generators are faster still and the quality of randomness is better. There are hardly any people recommending Mersenne Twister nowadays, and many languages and applications have stopped using it. The only thing going for it is a period of 2^19937 − 1. My CMWC4096 has a period of 2^131086 leaving MT standing. MT has had its day - RIP.