Code-a-holic: October 2005

Thursday, October 20, 2005

[VBScript] Shell and Heap Sorts

The final versions of the Shell sort and Heap sort classes. First the ShellSorter:

class ShellSorter 
'~ http://www.iti.fh-flensburg.de/lang/algorithmen/sortieren/shell/shell.htm
    private a
    private n

    public sub sort(a0)
        a = a0
        n = UBound( a ) + 1
        shellsort
    end sub

    public function sorted()
        sorted = a
    end function

    private sub shellsort()
        dim i, j, k, h, t
        dim cols
        cols = array( 1391376, 463792, 198768, 86961, 33936, _
                    13776, 4592, 1968, 861, 336, 112, 48, 21, 7, 3, 1 )
        
        for k = 0 to UBound( cols )
            h = cols( k )
            for i = h to n - 1
                j = i
                t = a( i )
                do while j >= h
                    if a( j - h ) <= t then exit do
                    a( j ) = a( j - h )
                    j = j - h
                loop
                a( j ) = t
            next
        next
    end sub
end class

and then the HeapSorter

class HeapSorter 
    '~ http://www.iti.fh-flensburg.de/lang/algorithmen/sortieren/heap/heapen.htm
    private aVector
    private n

    public sub sort( aVec )
        aVector = aVec
        n = UBound( aVector ) + 1
        heapsort
    end sub

    public function sorted()
        sorted = aVector
    end function

    private sub heapsort()
        buildheap
        do while n > 1
            n = n - 1
            exchange 0, n
            downheap 0
        loop
    end sub

    private sub buildheap()
        dim v
        for v = int( n / 2 ) - 1 to 0 step -1
            downheap v
        next
    end sub

    private sub downheap(v)
        dim w
        w = 2 * v + 1   '// first descendant of v
        do while w < n
            if w + 1 < n then   '// is there a second descendant?
                if aVector( w + 1 ) > aVector( w ) then
                    w = w + 1
                end if
            end if

            '// w is the descendant of v with maximum label
            if aVector( v ) >= aVector( w ) then
                exit sub  '// v has heap property
            end if

            '// otherwise
            exchange v, w  '// exchange labels of v and w
            v = w          '// continue
            w = 2 * v + 1
        loop
    end sub

    private sub exchange(i, j)
        dim t
        t = aVector( i )
        aVector( i ) = aVector( j )
        aVector( j ) = t
    end sub

end class

By the way, I'm unemployed again. Things might be a bit quiet around here for a while.

Saturday, October 15, 2005

[VBScript] sorting algorithms

Thanks to Dr Hans Werner Lang for his helpful comments on the sorting routines, as below:

Hi,
but there is no need to rewrite the outer loop, is it?
    for i=h to n-1
    ...

The inner loop, with the problem of the conditional And, could be written as
    do while j>=h
        if a(j-h)<=t then exit do
        ...
    loop

In my opinion, exit do should be avoided (when possible).

Regards
H.W. Lang

I've made the changes to the class as suggested but haven't posted them as yet.

[MetaCard] Starter Kit script size limit, Part 2

And if anyone was curious what happened to the MetaCard script size issue, Ken Ray said,

>I've been told, via the MetaCard list, that you have a technique for
>getting around the script size limit in MetaCard. If that's so, please
>can you tell me whence I can download the whitepaper about it.

Sorry to disappoint you, Bruce, but I don't. In fact, given that DreamCard is only $99, it seems counterproductive to attempt to get around the script size limits when you can pick up a full development environment very inexpensively.

and Geoff Canyon said

I don't recall that I wrote anything in particular. I did write an exporter for the documentation for earlier versions of Revolution, and they had a small section on dealing with the script limits in the starter kit. The basic point is to understand how to write tight code. You can insert scripts in front and back, and "start using" stacks, and use nested groups to your advantage. You can also store scripts in custom properties and use the "do" command on them.

If you ask on the mailing list, there are several people there who spent significant time working within the script limits who can probably help you with any specific issues. I bought a license early on so I don't have much practical experience.

Finally, if you're concerned about whether Rev is a good fit for what you want to do, ask on the list. People will tell you the truth. There are (many) things Rev is very good for, and (almost as many) things it isn't well suited for.
>I'm told that, sometime late last century, you wrote
>something about side-stepping the script size limit in
>the MetaCard unregistered version.

So the upshot of all this is: spend some money and stop complaining.

Thursday, October 13, 2005

[xbScript] Hooley Dooley! Move over VBScript, here comes xbScript

This is just amazing! "xbScript.dll enables xBase scripting (exactly like MS vbScript and JScript) in any MS ActiveScript compliant Host." Now I can help a friend, who has a large legacy Clipper app running in DOS under Windows, to integrate his software into the Windows environment. And he won't have to learn another language when he wants to tweak things. Hallelujah!!

[EOC] T minus 2 and counting

It's Thurday. I'm busily updating the documentation.

Friday 14 October is "The Last Day". (I wish it was THE last day, that is, the day Jesus returns.)

Of the 19 agencies I've written to, 4 have replied to say they're working on it. Looks like it's back to getting suited up and walking from agency to agency in the Perth CBD saying, "G'day, remember me? Yeah, I'm actually 3D and have feelings."

There's this disease one can get -- I get it often -- called PLOM disease: Poor Little Old Me.

Wednesday, October 12, 2005

[VBScript] Please, please, no more sorting!!

After so many tries, I had thought I was done with it. Well the virtual memory limit on my machine still stands so when the shellSort encountered an array of 1.5 million records, it failed. I could have gone ahead with getting the VM size increased but decided it was better to deal with the limitation as it stood. Who knows, the next bloke may not have much virtual memory either (though, I suppose, he's more likely to have lots more.)

I handed the job over to SORT.EXE and used the Exec method to call it. Like this:

Dim sSamplesFilename, sSamplesData, aSamplesData, sSampleItem
sSamplesFilename = Join( Array( sReportPath, sTableName & "_DataStream.txt" ), "\" )
If isFile2( sSamplesFilename ) Then
    oSamples.ReadFile sSamplesFilename   
End If

WScript.Echo "Sorting " & FormatNumber( oSamples.ByteLength / 2, 0,,,-1) & " Unicode bytes to " & BaseName( sSamplesFilename )
oSamples.WriteFile "TemporaryFile.$$$", adSaveCreateOverWrite
SortFile "TemporaryFile.$$$", sSamplesFilename

The actual call to SortFile is what were talking about but the oSamples stuff needs some explaining.

Dim oSamples
Set oSamples = New SuperContainer

SuperContainer is a class based on the ADODB.Streams object.

Class SuperContainer
    private oStream

    Private Sub Class_Initialize()
        Set oStream = CreateObject( "ADODB.Stream" )
        oStream.Open
    End Sub

    Public Sub Store( sText )
        oStream.WriteText sText
    End Sub

    Public Function Recall()
        Dim sResult
        oStream.Position = 0
        sResult = oStream.Read( adReadAll )
        Recall = sResult
    End Function

    Public Sub ReadFile( sFilename )
        Dim sText
        Dim aText
        Dim sItem
        Dim nStart
        Dim nFinish
        If IsFile2( sFilename ) = True Then
            sText = Chomp( GetFile( sFilename ) )
            aText = Split( sText, VbNewLine )
            nStart = oStream.Position
            For Each sItem in aText
                oStream.WriteText sItem & VbNewLine
            Next
            nFinish = oStream.Position
            
            WScript.Echo  FormatNumber( nFinish - nStart / 2, 0,,,-1) & " ubytes read from " & sFilename
        Else
            WScript.Echo "Cannot find " & sFilename
        End If
    End Sub
    
    Public Sub WriteFile( sFilename, nMode )
        oStream.SaveToFile sFilename, nMode
    End Sub
    
    Private Sub Class_Terminate()
        oStream.Close
        Set oStream = Nothing
    End Sub

    Public Function ByteLength()
        ByteLength = oStream.Size
    End Function
    
End Class

Interestingly I had a lot of trouble with the ReadFromFile method in ADODB.Stream. I think this had to do with it expecting Unicode but getting ASCII. When you hand a Unicode file over to SORT.EXE, it sorts it okay but changes it into ASCII. ReadFromFile tries to interpret the file as Unicode and you end up with a mess. Thus the GetFile()/Split/For Each thing in my ReadFile method.

The code for the sorting routine is:

Sub SortFile( sInputFilename, sOutputFilename )
    Const sCommandline = "SORT ""%IN%"" /O ""%OUT%"""
    Dim oExec
    Dim sCommand
    sCommand = Subst3( sCommandline, Array( Array( "IN", sInputFilename ), Array( "OUT", sOutputFilename ) ) )
    If bDebugging = True Then
        Info "SortFile: Exec> " & sCommand
    End If
    Set oExec = oShell.Exec( sCommand )
    Do While oExec.Status <> 1
        WScript.Sleep 100
    Loop
    If bDebugging = True Then
        If Not oExec.StdOut.AtEndOfStream Then
            Info "SortFile: StdOut> " & oExec.StdOut.ReadAll
        End If
    End If
End Sub

I have a global in my stdFunctions.vbs called bDebugging. It's normally False but I can change it and get some useful feedback thereby.

The upshot of all this is that the sorting seems to be working ... but still not perfectly -- when I gave SORT.EXE a 63 Gigabyte file it didn't like it. But the likelihood of generating datasets that large is low.

[VBScript] read and write local and remote files

Check out a wonderful write up by Antonin Foller of PSTRUH Software on reading and writing files in VBScript. Note the very helpful stuff on Binary Files.

[General] Mergesort

This is a great site for algorithms, like Mergesort. A round of applause for the author, Prof. Dr. H. W. Lang.

It's mostly German language, but there are some English translations and the Java code is fairly human-language-neutral.

Tuesday, October 11, 2005

[VScript] At last, a working shell sort

Finally found a shell sort that works. The problems I had previously might have been had because of this:

while (j>=h && a[j-h]>t)

I converted that straight to VBScript and kept crashing because a[j-h] with a negative index would get evaluated. By using a do/loop and breaking the test up into two parts

    do
                    if j < h then
                        exit do
                    end if
                    if a( j - h ) <= t then
                        exit do
                    end if

... I got stuff to work. Here's the code. Usage is similar to that for heap sort.

class ShellSorter 
'~ http://www.iti.fh-flensburg.de/lang/algorithmen/sortieren/shell/shell.htm
    private a
    private n
    
    public sub sort(a0)
        a = a0
        n = UBound( a ) + 1
        shellsort
    end sub

    public function sorted()
        sorted = a
    end function
    
    private sub shellsort()

        dim i, j, k, h, t
        dim cols
        cols = array( 1391376, 463792, 198768, 86961, 33936, _
                    13776, 4592, 1968, 861, 336, 112, 48, 21, 7, 3, 1 )
        
        for k = 0 to UBound( cols )
            h = cols( k )
            
            i = h
            do
                if i >= n then
                    exit do
                end if
                
                j = i
                t = a( i )
                do
                    if j < h then
                        exit do
                    end if
                    if a( j - h ) <= t then
                        exit do
                    end if
                
                    a( j ) = a( j - h )
                    j = j - h
                    
                loop
                
                a( j ) = t
                
                i = i + 1
            loop
        next
            
    end sub

end class

[VBScript] Arrrghh!! Sorting out sorting ...

Just when I thought my problems were all over ... or at least the sorting ones ... I found that my machine didn't have enough virtual memory to handle the sort using ADODB (and I don't have the privilege level to do anything about it).

So I ported a heap sort to VBScript and ... so far ... everything look like it's going to work.

Here's the code

class HeapSorter 
    '~ http://www.iti.fh-flensburg.de/lang/algorithmen/sortieren/heap/heapen.htm
    private aVector
    private n

    public sub sort( aVec )
        aVector = aVec
        n = UBound( aVector ) + 1
        heapsort
    end sub

    public function sorted()
        sorted = aVector
    end function
    
    private sub heapsort()
        buildheap
        while n > 1
            n = n - 1
            exchange 0, n
            downheap 0
        wend
    end sub
    


    private sub buildheap()
        dim v
        for v = int( n / 2 ) - 1 to 0 step -1
            downheap v
        next
        
        '~ for (int v=n/2-1; v>=0; v--)
            '~ downheap (v);
    end sub


    private sub downheap(v)
        dim w
        w = 2 * v + 1   '// first descendant of v
        while w < n
        
            if w + 1 < n then   '// is there a second descendant?
                if aVector( w + 1 ) > aVector( w ) then
                    w = w + 1
                end if
            end if
            '// w is the descendant of v with maximum label

            if aVector( v ) >= aVector( w ) then
                exit sub  '// v has heap property
            end if
            '// otherwise
            exchange v, w  '// exchange labels of v and w
            v = w          '// continue
            w = 2 * v + 1
        wend
    end sub


    private sub exchange(i, j)
        dim t
        t = aVector( i )
        aVector( i ) = aVector( j )
        aVector( j ) = t
    end sub

end class

... and to use it, something like this ...

            Set oHeap = New HeapSorter
            oHeap.sort aVector
            aSortedVector = oHeap.sorted()

[VBScript] Sorting ... another way

I have tried and tried to get Shell sorts working but every algorithm I've tried ends up crashing out with negative indexes into the array.

So below is another way around the whole issue: create a RecordSet, populate it with fields, add data to it and use the RecordSet's own internal sorting routines.

class Container2
    private oRecordSet

    Private Sub Class_Initialize()
        Const adVarWChar = 202
        Dim oFields
        Set oRecordSet = CreateObject( "ADODB.RecordSet" )
        Set oFields = oRecordSet.Fields
        oFields.Append "Data", adVarWChar, 255
        oRecordSet.Open
    End Sub

    Public Sub Add( sText )
        oRecordSet.AddNew "Data", sText
    End Sub

    Public Function Extract()
        Const adClipString = 2
        Dim sResult
        sResult = oRecordSet.GetString( adClipString, oRecordSet.RecordCount, , , "")
        Extract = sResult
    End Function
    
    Public Sub Sort( sDirection )
        Dim sSort
        sDirection = UCase( Left( sDirection, 1 ) )
        Select Case sDirection
        Case "A"
            sSort = "Data ASC"
        Case "D"
            sSort = "Data DESC"
        Case Else
            sSort = "" ' no sort, natural order
        End Select
        WScript.Echo "Sorting " & oRecordSet.RecordCount & " items"
        oRecordSet.Sort = sSort
            
    End Sub

    Private Sub Class_Terminate()
        oRecordSet.Close
        Set oRecordSet = Nothing
    End Sub

    Public Sub SaveData( sFilename )
        Const adPersistADTG = 0
        oRecordSet.Save sFilename, adPersistADTG
    End Sub
    
    Public Sub SaveXML( sFilename )
        Const adPersistXML = 1
        oRecordSet.Save sFilename, adPersistXML
    End Sub

end class

And a trivial example of its use

function rangedRandom( nLoBound, nHighBound )
    rangedRandom = Int((nHighBound - nLoBound + 1) * Rnd + nLoBound)
end function

dim c
set c = new container2

randomize
dim x(100)
for i = 100 to 0 step -1
    c.add rangedRandom(1,1000) & vbtab & "my dog has " & i & " fleas"
next
c.sort "Ascending"
wscript.echo c.extract

filedelete("dim.dat")
c.savedata "dim.dat"
filedelete("dim.xml")
c.savexml "dim.xml"

Monday, October 10, 2005

[VBScript] Synthetic Includes in Traditional VBScript Files

Most of us are aware of the entry "Synthetic Includes in Traditional VBScript Files" in the Rube Goldberg Memorial Scripting Page.

Today I stumbled across how to embed test routines in the include file without causing these routines to be activated when the file is included.

My include file is called "StdFunctions.vbs". At the bottom of the file I've put

If BaseName( WScript.ScriptFullName ) = "StdFunctions.vbs" Then
    WScript.Echo "Testing StdFunctions.vbs"
    'tests go here
End If

When StdFunctions.vbs is included by a script, ScriptFullName evaluates to the name of that script. It's only when StdFunctions.vbs is run by itself that ScriptFullName ends with "StdFunctions.vbs".

BaseName is one of my routines and look a bit like this:

Function BaseName( aFile )
    Dim oFSO
    Set oFSO = CreateObject( "Scripting.FileSystemObject" )
    BaseName = oFSO.GetFileName( aFile 
End Function

[later that same day]

Read the manual, Bruce, read the manual: why use Basename with .ScriptFullName when you can just use .ScriptName?

[EOC] Other things it could mean

Meaning	Contributor
Elongated Orbital Crocodile	Bruce Axtens
Emu-Olive Cross	Daniel Axtens
Extra Old Codger	Robert Glanville, Icon Recruitment

Friday, October 07, 2005

[EOC] End of Contract

I've got one more week and then I'm unemployed again.

I feel down. I wish there was something "cutting edge" I could do. Everything I can think of is diametrically opposed to the cutting edge, being either the blunt bit at the back of the knife or the even blunter bit on top of the chisel handle.

Who cares about MetaCard? Who cares about S*BOL but a few diehard fanatics (who are mostly older and greyer than me)? Who cares about Clipper or xHarbour but a few South Americans into retro memorabilia? As for VBScript, this is just one of thousands of websites and I'm a relative newcomer to a tool that's been around for very long time.

Eventually I'll have posted all my MoonRock BASIC, Fitted Software Tools Modula-2, Turbo Pascal 5 and Euphoria code. Whooptie do. Even if I finish my CCNA, learn Haskell, and write Kiwi CatTools equivalents ... who cares?

[MetaCard and Tcl] Blogs.mc

I got asked to describe the stack a little better. Here goes:

My blogs.mc stack has two text fields (fSource and fGenerated) and some buttons at the bottom (create_card, first, prev, next, last, render, preview, delete).

With some marked-up text in the fSource field, I click 'render' and the output of the Tcl script (HTML) is put into the fGenerated field (line 6 of the 'Render' script).

Then when I click on 'preview' the HTML in the fGenerated field gets dumped to a file and passed to Safari. The fGenerated field is modifiable so I can play with things to get what I want and then tweak the Tcl script appropriately afterwards.

About the same time I posted this to the MetaCard list:

On my blog, codeaholic.blogspot.com, I've posted an item about MetaCard (on OS X) using Tcl to more-or-less bypass the script size limit of the unregistered version of MetaCard.

Richard Gaskin wrote back, saying (in part):

since there is no MetaCard anymore anyway, and since Rev only offers a 30-day trial for the engine, I'm not sure how helpful the article will be.

At $99 for the low-end Rev license, is the pricing really so prohibitive?

Also Alejandro Tejada wrote

i do not see how this could get around the 10 lines limit, but Geoff Canyon wrote an extensive tutorial to manage longer scripts within the 10 lines limits.

This tutorial is still useful for developers that want to run longer scripts in their standalone applications.

I get it from Ken Ray's website within the RR v 1.1 docs (saved as a pdf file). i'm not sure if this tutorial is still available in any website.

You could ask directly to Geoff Canyon. Look for his website: inspiredlogic.com

I answered with

> i do not see how this could get around the
> 10 lines limit,

bad choice of words on my part. It doesn't so much get around it as it does acquiesce to the fact and try to use other tools to do what can't otherwise be done. Instead of using MetaCard's HTML mechanism or writin8g something in MetaTalk, I've farmed out the functionality to a Tcl script.

> but Geoff Canyon wrote an
> extensive tutorial to manage longer scripts
> within the 10 lines limits.

of this I was unaware. I have thought about doing something similar. What I usually end up doing however, when I need to hang more closely to MetaCard is to use AppleScript and 'do script' or 'evaluate' the things I need. I will nevertheless make enquiries now that I know better.

Wednesday, October 05, 2005

[General] Five year from now, Google will dwarf Microsoft

Networking Pipeline | Blog | Will Google Buy AOL?

[General] Neuronstorm website update

I'm supposed to be one of the admins for Neuronstorm and when I successfully extract the digit, I'm to implement the Neuronstorm OSI (operating system interface) in GTk for Windows (and possibly Mac OS X).

Daniel's a good developer and there's certainly a fair bit of interest at his school in an open-source version of Inspiration™.

Monday, October 03, 2005

[Clipper 5.3 / xHarbour] .DBF to .CH (Clipper Header)

The client had Clipper 5.3. I had xHarbour. The client had a database of constants. I turned them into a .ch (Clipper Header) file with this bit of code which compiled both under xHarbour and Clipper 5.

procedure main()
        local cFName, vFValue
        local cCValue, cCName
        local nMax, i
        local h
        local cType
        local CRLF := CHR(13)+CHR(10)
        local cLine

        h := FCREATE( "./dispense.ch", 0 )
        ? h
        use numbers alias num
        goto 1
        nMax := FCOUNT()
        for i = 1 to nMax
                cFName := FIELDNAME( i )
                *? cFName
                cCName := "CONST_" + cFName
                vFValue := &cFName
                cType := VALTYPE(vFValue)
                *? cType
                DO CASE 
                        CASE cType == "C"
                                cCValue := '"' + vFValue + '"'
                        CASE cType == "N"
                                cCValue := STR( vFValue )
                        CASE cType == "D"
                                cCValue := DTOC( vFValue )
                        CASE cType == "L"
                                cCValue := IIF( vFValue, ".T.", ".F." )
                        OTHERWISE
                                ? "Don't know what to do with a cType of " + cType
                                QUIT
                END CASE
                cLine := "#define " + cCName + " " + cCValue + CRLF 
                ? cLine
                FWRITE( h, cLine )
                

        next
        FCLOSE( h )
        CLOSE DATABASES
        QUIT

[VBScript] 99 bottles of beer - "class" version

Check out my 99 bottles of beer submission.

Look at the entries for your own favourite language. Some of them a dead boring. Submit an example that would show off the real power of the language.

If you're using a language that isn't on the board, submit a version of the song in that too.