Saturday, November 07, 2015

[COBOL] Sum multiples of 3 and 5

Last night I posted the following code on RosettaCode as another solution to the Sum multiples of 3 and 5 challenge. (Mine is the third one down after all the more-mathematical solutions.)

My solution is as brute-force as it gets, using only adds and comparisons.
       PROGRAM-ID. SUM35.

           88 IS-THREE VALUE 3.
       01  FIVE-COUNTER    USAGE BINARY-CHAR value 1.
           88 IS-FIVE VALUE 5.
       01  SUMMER          USAGE BINARY-DOUBLE value zero. 
       01  I               USAGE BINARY-LONG.
       01  N               USAGE BINARY-LONG.

           MOVE 1000000000 TO N.
           MOVE 1 TO I.
           DISPLAY SUMMER.
           STOP RUN.
           IF IS-THREE OR IS-FIVE 
               ADD I TO SUMMER END-ADD
               IF IS-THREE
                   MOVE 1 TO THREE-COUNTER
                   ADD 1 TO THREE-COUNTER
               IF IS-FIVE
                   MOVE 1 TO FIVE-COUNTER
                   ADD 1 TO FIVE-COUNTER
               ADD 1 TO FIVE-COUNTER END-ADD
           ADD 1 TO I.
The above code compiles on GnuCOBOL 2.0 and MicroFocus Visual COBOL 2.3. In the latter environment, I was able to get a run time of 7.3 seconds for the 1,000,000,000 iterations (AMD A6-5200 APU running at 2.00 GHz.)

I ended up in COBOL via the usual circuitous route through other programming languages after figuring out a solution using
mLite. The next postings will demonstrate the mLite and perhaps others.

© Copyright Bruce M. Axtens., 2015

Sunday, October 11, 2015

[GnuCOBOL 2.0] Beginning COM

In my ample (NOT!) spare time, I'm exploring making COM available to the Windows implementation of GnuCOBOL. You can do GnuCOBOL on Linux and Mac as well.

Many thanks to
Brian Tiffin over on GnuCOBOL's Sourceforge Forum for cheering me on.
           88 S_OK     VALUE 0.
           88 S_FALSE  VALUE 1.
       01  NUL         USAGE BINARY-LONG VALUE 0.
        CALL STDCALL "OleInitialize"
            USING BY VALUE NUL
            DISPLAY HRESULT.

        CALL STDCALL "OleUninitialize" USING
            GIVING NULL.

            STOP RUN.
The are some runtime settings (Windows 10 Home, 64bit) required to get that working, namely
set COB_PRE_LOAD=ole32
set COB_LIBRARY_PATH=C:\windows\syswow64
I should sometime create a Github project for this, in case others want to run with it.

© Copyright Bruce M. Axtens, 2015

[CSNOBOL4] Decimal to Binary #2

Many thanks to Gordon Peterson who took my non-idiomatic code and improved it both in size and speed, viz
         DEFINE("BIN(N)")                            :(BIN_END)
BIN      BIN = (GT(N,1) BIN(N / 2), ) REMDR(N,2)     :(RETURN)
This is guru level stuff.

I'm also grateful to
Fred Weigel who first responded to my posting in the Snobol Yahoo! Group and made some very useful suggestions. He points out that Gordon's solution is a prime candidate for DEXP, viz:
dexp('bin(n) = (gt(n, 1) bin(n / 2), ) remdr(n, 2)')
That's enough CSNOBOL4 for now, though if you do want to spend some time with it (Windows or Linux), I'd suggest using Rafal M. Sulejman's TkSLIDE.

© Copyright Bruce M. Axtens, 2015

Wednesday, October 07, 2015

[CSNOBOL4] Decimal to Binary

Okay, I think this is the last of the solutions to Binary Digits. Thie one's in CSNOBOL4. Kudos to Phil Budne for maintaining and expanding this amazing programming language.

The code below, like all the ones before it, is recursive.
        DEFINE('BIN(N,STR)')              :(BIN_END)
BIN     EQ(N,0)                           :S(NZERO)
        BIN = BIN(N / 2, REMDR(N,2) STR)  :S(RETURN)
NZERO   BIN = EQ(SIZE(STR),0) '0'         :S(RETURN)
        BIN = STR                         :(RETURN)

        OUTPUT = BIN(0)
        OUTPUT = BIN(5)
        OUTPUT = BIN(50)
        OUTPUT = BIN(9000)

© Copyright Bruce M. Axtens, 2015

[Euphoria] Decimal to Binary

Having solved the Binary Digits task in mLite and FBSL, I thought I'd have a go in OpenEuphoria. Kudos to David Craig of Rapid Deployment Software for the original implementation and to the subsequent team of heroes for a very powerful Windows/Linux/Mac programming (interpreted and/or compiled) language.

The code below, expressed in v4.1.0 form, follows the FBSL fairly closely.
include std/math.e 
include std/convert.e

function Bin(integer n, sequence s = "")
  if n > 0 then
   return Bin(floor(n/2),(mod(n,2) + #30) & s)
  end if
  if length(s) = 0 then
   return to_integer("0")
  end if
  return to_integer(s)
end function

printf(1, "%d\n", Bin(0))
printf(1, "%d\n", Bin(5))
printf(1, "%d\n", Bin(50))
printf(1, "%d\n", Bin(9000))
There's already an Euphoria solution to the task. Some enterprising soul might want to check which of the two solutions is the faster.

© Copyright Bruce M. Axtens, 2015

[FBSL] Decimal to Binary

Having solved the Binary Digits task in mLite, I thought I'd have a go in FBSL. Kudos to the FBSL team for a very useful and powerful Windows scripting language. Even ABAP users can leverage it!

The code below, expressed in v3.5 RC form, follows the mLite fairly closely.

#AppType Console
function Bin(byval n as integer, byval s as string = "") as string
 if n > 0 then return Bin(n \ 2, (n mod 2) & s)
 if s = "" then return "0"
 return s
end function

print Bin(5)
print Bin(50)
print Bin(9000)

It was during the testing of this code that it dawned on me that the mLite wasn't handling the binary 0; appropriately. Thus those who notice such things will discover a subtle change in the mLite posting.

© Copyright Bruce M. Axtens, 2015

Tuesday, October 06, 2015

[mLite] Convert to Binary Notation

A short diversion: the Standard ML dialect called mLite is where I go for the intellectual challenge of thinking in a functional programming way. Kudos to Nils M. Holm for developing it. mLite is one of the languages I use to solve RosettaCode tasks, in this case, Binary Digits.

This turned out to be a fairly simple task and only took me a few minutes to solve. Granted, I reused some code from the logarithm calculator of a few postings ago, but that was just for the conversion of a list of numbers to their printable form.
fun binary
   (0, []) = "0"
 | (0, x) = implode ` map (fn x = if int x then chr (x + 48) else x) x
 | (n, b) = binary (n div 2, n mod 2 :: b)
 | n = binary (n, [])
The gist of that is
  • pass in a number and recurse with the number and an empty list.
  • With a number that isn't zero recurse with the number divved by 2 and the list prepended with the number modded by 2.
  • Keep going until the number is zero. At that point, convert the answer's digits to string representation and implode them into a single string.
  • If the number is zero and there are no digits, return "0"
Might get back to some VB6 next. Or javascript.
© Copyright Bruce M. Axtens, 2015

Sunday, October 04, 2015

[VB6] Map and Reduce

Following on from a previous posting about Fluent VB6 we look now at two routines which pop up a lot these days: Map and Reduce. On offer here is one way of implementing these two functional programming stalwarts. They are presented here as part of a FluentVB6 object, but could just as easily be declared and used separately.

I'm implementing these using the
MSScript object which also appeared in the aforementioned posting. This makes available to the programmer, out of the box, the functionality of two scripting languages, VBScript and JScript. Other languages are available within the Windows Scripting Host environment and these could also be used (e.g. PerlScript as per the link.)

The code below tests the Map and Reduce functions. After this the implementation will be discussed.
Dim words As New Collection
    words.Add "cat"
    words.Add "dog"
    words.Add "cow"
    words.Add "wolf"
    words.Add "rat"
    Dim F As New FunctionalObject
    Dim upperwords As New Collection
    Set upperwords = F.WorkingWith(words).Map("UCase(Value)").AsCollection()
    Dim concatenated As Variant
    concatenated = F.WorkingWith(upperwords).Reduce(vbNullString, "InitValue = InitValue & Value").asValue()
    Dim counted As Variant
    counted = F.Reset().WorkingWith(upperwords).Reduce(0, "initValue = initValue + Len(Value)").asValue()
For the sake of simplicity, I'm limiting things to Collections in, Collections and Variants out. The code could be readily changed to handle Arrays, Dictionaries and other data structures.

The class is called FunctionalObject and it begins with
Option Explicit

Private workingCollection As Collection
Private incomingCollection As Collection
Private workingValue As Variant
Private SC As ScriptControl

Private Sub Class_Initialize()
    Set workingCollection = New Collection
    Set incomingCollection = New Collection
    workingValue = vbEmpty
    Set SC = New ScriptControl
End Sub
No surprises there. Again, the ScriptControl object is the OCX added via the Project menu as a Reference rather than as a Component. One could late-bind with CreateObject but there's not much point in this case.

Next the public function to receive the incoming collection
Public Function WorkingWith(inCol As Collection) As FunctionalObject
    Set incomingCollection = inCol
    Set WorkingWith = Me
End Function
Reset clears the workingCollection (in the event that you reuse the currently instantiation of the FunctionalObject rather than instantiate another one.)
Public Function Reset() As FunctionalObject
    Dim i As Integer
    For i = 1 To workingCollection.Count
        workingCollection.Remove 1
    workingValue = vbEmpty
    Set Reset = Me
End Function
wrapText you'll seen before from the previous posting. It just makes the incoming collection's value palatable to VBScript.
Private Function wrapItem(v As Variant) As String
    If VarType(v) = vbString Then
        wrapItem = Chr$(34) & v & Chr$(34)
        wrapItem = CStr(v)
    End If
End Function
Next the Map function. The ScriptControl language is set to VBScript and the "safe subset" of script language functions is selected. Then the code iterates through each element of the incoming collection, and sets a VBScript place-holder variable called Value to that element. Next the map script is evaluated in the context of Value, the result being added to the working collection.

The example at the top of page has the map script as "UCase(Value)", so the value stored in the working collection is the uppercase of the value in the incoming collection.
Public Function Map(Optional script As String = "Value") As FunctionalObject
    SC.Language = "VBScript"
    SC.UseSafeSubset = True
    Dim i As Integer
    For i = 1 To incomingCollection.Count
        SC.ExecuteStatement "Value = " & wrapItem(incomingCollection.Item(i))
        workingCollection.Add SC.Eval(script)
    Set Map = Me
End Function
Reduce works in a similar manner except the result is a variant. There is the expectation that the reduce script will somehow work toward deriving a single value from the incoming collection, thus the use of an second place-holder called InitValue. The first parameter of the Reduce call is stored in InitValue with the expectation that the reduce script will refer to it and to the Value place-holder.

For example, one of the examples from the first code block reads, in part,
Reduce(0, "initValue = initValue + Len(Value)").
This reduces the collection to a value accruing the lengths of the strings assumed to be in the incoming collection.

Both parameters to Reduce are marked as optional. If neither is specified, the Reduce does nothing except set Value to InitValue, effectively filling the working collection with as many zeroes as there are items in the incoming collection.
Public Function Reduce(Optional initval As Variant = 0, Optional script As String = "Value = InitValue") As Variant
    SC.Language = "VBScript"
    SC.UseSafeSubset = True
    Dim vAnswer As Variant
    Dim vItem As Variant
    Dim vResult As Variant
    Dim i As Integer
    SC.ExecuteStatement "InitValue = " & wrapItem(initval)
    For i = 1 To incomingCollection.Count
        vItem = incomingCollection.Item(i)
        SC.ExecuteStatement "Value = " & wrapItem(vItem)
        SC.ExecuteStatement script
    workingValue = SC.Eval("InitValue")
    Set Reduce = Me
End Function
Finally the two output functions, asCollection and asValue. The former copies the working collection to an answer collection and returns that to the caller. asValue returns the working value from the Reduce.
Public Function AsCollection() As Collection
    Dim answerCollection As New Collection
    Dim i As Integer
    For i = 1 To workingCollection.Count
        answerCollection.Add workingCollection.Item(i)
    Set AsCollection = answerCollection
End Function

Public Function asValue() As Variant
    asValue = workingValue
End Function
I will make the sources available on Github in the near future.

© Copyright Bruce M. Axtens, 2015

Friday, October 02, 2015

[VB6] What about Me a.k.a. Method Chaining a.k.a. Fluent VB6

This is nothing to do with Shannon Noll's song, What about Me. No, it's about Method Chaining, the mechanism described in Fluent Javascript and making that same mechanism available to the VB6 programmer.

But first, kudos. I am grateful to Vidar Løvbrekke Sømme. On his blog, he posted an article called
Bending Vb6 in the functional direction. In that article, he gives his take on method chaining. What follows is my take on the subject.

Having found a way to get
VB6 running without emulation in 64bit Windows 10, I've been encouraged to get back into it and revisit some of my older projects.

So what's this got to do "What about Me"? Well, the thing that makes method chaining possible in JavaScript is the this keyword. The VB6 equivalent keyword is Me.

The challenge is to create a mechanism which allows something like Vidar's
concatenated = List.From(originalCollection).SelectProperty("Property").Concat(",")

— But this isn't too bad, is it?

What I've done doesn't use Map or Reduce (I have implemented those but differently and I'll deal with both in a subsequent post.)

First, launch the VB6 IDE, create a new project and remove the default form. Next create a class and call it SelectorObject. In the code editor for the class enter class variables, viz
Dim cWorking As Collection
Dim dWorking As Dictionary
Dim aWorking() As Variant
Dim iWorking As Integer
Dim cOriginal As Collection
Dim dOriginal As Dictionary
Dim aOriginal() As Variant
Dim sPattern As String
Dim bPatternDefined As Boolean
Dim oScript As ScriptControl

Private Enum FROMS
    FromCollection = 1
    FromDictionary = 2
    FromArray = 3
    Fromstring = 4
End Enum

Dim source As FROMS
The above is out of my own project so there's extra stuff in there that goes beyond Vidar's original. Ultimately I'd like to be able to hand a Collection, Dictionary, Array or String to the class and be able to pull out of it a Collection, Dictionary, Array or String. The code you'll see is part way to realising that.

Notice also the Dim oScript As ScriptControl. To make an element selection mechanism, I'm calling in the
MSScript OCX object (as a Project Reference).

Next comes the class initialisation
Private Sub Class_Initialize()
    Set cWorking = New Collection
    Set dWorking = New Dictionary
    sPattern = vbNullString
    bPatternDefined = False
    iWorking = -1
    Set oScript = New ScriptControl
    oScript.Language = "VBScript"
    oScript.UseSafeSubset = True
End Sub
Next the first public function Selecting which will introduce the selection statement. I'd love to be able to use Select, but that's a VB6 reserved word. Notice the use of the Me keyword. Because it's an object, it has to be assigned to the function name (as a return value) using Set.
Public Function Selecting() As SelectorObject
    Set Selecting = Me
End Function
Next the From public function. This ascertains the type of the incoming variable and assigns it to a relevant worker object. An enum takes care of letting the class know what was passed in.
Public Function From(c As Variant) As SelectorObject
    If TypeName(c) = "Collection" Then
        Set cOriginal = c
        source = FromCollection
    ElseIf TypeName(c) = "Dictionary" Then
        Set dOriginal = c
        source = FromDictionary
        If VarType(c) = vbArray Then
            aOriginal = c
            source = FromArray
            aOriginal = Split(c, "")
            source = Fromstring
        End If
    End If
    Set From = Me
End Function
Next comes the Where function. Rather that doing any further processing, the Where simply accepts the 'where' text (a script fragment for MSScript to use later) and a flag to say we have it is set.
Public Function Where(pattern As String) As SelectorObject
    sPattern = pattern
    bPatternDefined = True
    Set Where = Me
End Function
Next a helper function which puts double quotes around strings and leaves other data types undecorated. This exists because the current element in the Collection/Dictionary/Array/String is assigned to a VBScript variable before the Where script is evaluated. Being a VBScript assignment statement, double quotes need to be around strings. At this point there is no special handling for booleans and dates etc.
Private Function WrapData(data As Variant) As String
    If VarType(data) = vbString Then
        WrapData = Chr$(34) & data & Chr$(34)
        WrapData = CStr(data)
    End If
End Function
Finally, one of the three output routines. This is where all the hard work is done. Notice that these functions don't specify SelectorObject as the return type. In this first case, a Collection is returned. The Dictionary output routine has not been written.

Notice also that, if a Where clause has been specified, the current item is set as a variable to the MSScript engine, and then the 'where' text is evaluated by MSScript, using the VBScript language. The result is interpreted as a boolean to decide whether or not to include the current item in the output collection. Otherwise, everything that went in comes out.
Public Function asCollection() As Collection
    Dim i As Integer
    Dim b As Boolean
    For i = 1 To cOriginal.Count
        If bPatternDefined Then
            oScript.ExecuteStatement "Value = " & WrapData(cOriginal.Item(i))
            b = CBool(oScript.Eval(sPattern))
            If b Then
                cWorking.Add cOriginal.Item(i)
            End If
            cWorking.Add cOriginal.Item(i)
        End If
    Set asCollection = cWorking
End Function
Next, a string output routine, with an optional argument to supply an inter-item separator.
Public Function asStringSeparatedBy(Optional separator As String = vbNullString) As String
    Dim i As Integer
    Dim b As Boolean
    Dim answer As String
    For i = 1 To cOriginal.Count
        If bPatternDefined Then
            oScript.ExecuteStatement "Value = " & WrapData(cOriginal.Item(i))
            b = CBool(oScript.Eval(sPattern))
            If b Then
                answer = answer & cOriginal.Item(i)
                If i < cOriginal.Count Then
                    answer = answer & separator
                End If
            End If
            cWorking.Add cOriginal.Item(i)
            If i < cOriginal.Count Then
                answer = answer & separator
            End If
        End If
    If bPatternDefined And Right$(answer, 1) = separator Then
        answer = Mid$(answer, 1, Len(answer) - 1)
    End If
    asStringSeparatedBy = answer
End Function
And finally, an output routine returning an array. The array element variable, iWorking, was initialised as -1, thus the pre-increment. Perhaps something else could be done about array initialisation to make things more efficient than a ReDim Preserve for each element.
Public Function asArray() As Variant
    Dim i As Integer
    Dim b As Boolean
    For i = 1 To cOriginal.Count
        If bPatternDefined Then
            oScript.ExecuteStatement "Value = " & WrapData(cOriginal.Item(i))
            b = CBool(oScript.Eval(sPattern))
            If b Then
                iWorking = iWorking + 1
                ReDim Preserve aWorking(iWorking)
                aWorking(iWorking) = cOriginal.Item(i)
            End If
            iWorking = iWorking + 1
            ReDim Preserve aWorking(iWorking)
            aWorking(iWorking) = cOriginal.Item(i)
        End If
    asArray = aWorking
End Function
That's all that's currently in the SelectorObject.

Now, out in the main module, in the Main subroutine, a couple of tests.
Dim words As New Collection
    words.Add "cat"
    words.Add "dog"
    words.Add "cow"
    words.Add "wolf"
    words.Add "rat"

    Dim S As New SelectorObject

    Debug.Print S.Selecting().From(words).Where("instr(Value,""o"") > 0").asStringSeparatedBy(",")
    Debug.Print Join(S.Selecting().From(words).Where("instr(Value,""a"") > 0").asArray(), "|")
The output being
So that's my take on Fluent VB6.

In my experimentations I have used this technique to re-implement Google Adwords SOAP request code that I originally wrote in JScript, viz
Dim pred As String
    Dim sele As String
    Dim campaignID As Long
    campaignID = 1000222

    Dim OPE As New OperationObject
    Dim PRE As New PredicateObject
    Dim SEL As New SelectObject
    pred = PRE.Field("CampaignId").Operator("=").Value(campaignID).toXML()
    sele = SEL.Fields("BudgetId").Fields("Amount").Predicates(pred).toXML()
    'sele = SEL.Fields("BudgetId").Fields("Amount").Predicates(PRE.Field("CampaignId").Operator("=").Value(campaignID).toXML()).toXML()

    Dim bid As Long
    bid = 2199199
    Dim amt As Long
    amt = 1000000
    Dim oper As String
    oper = OPE.Operator("SET").Field("budgetId").Value(bid).Amount(amt).toXML()

    Debug.Print pred
    Debug.Print sele
    Debug.Print oper
Okay, that's it. A long-winded posting, this one. If you have any questions, use the comments.


© Copyright Bruce M. Axtens, 2015

Monday, September 28, 2015

[JScript] jQuery without IE

For those who looked, this is mod of plasticgrammer's post. Most of the comments are Google Translates attempts at the original programmer's Japanese.

The single biggest difference from the previous posting is that Internet Explorer is not called into to manage jQuery. Instead the htmlfile object is used.

jQuery expects a few global symbols (it is after all a browser library), so the beginning of the code declares them: document, window etc. Then the jQuery file is dragged across the internet and eval'd in the context of the script.

You'll notice that the jQuery version is quite ancient. This is another problem with this approach. I imagine that it's just a case of declaring some more public symbols. If anyone tries this, please let me know how recent you can go before things break. And if you succeed in using more recent jQuery libraries, please do let me know what modifications were required.
// To prepare, such as window or document to the global name space
(function (url) {
  if ("undefined" === typeof document)
    document = new ActiveXObject("htmlfile");
  document.write("<" + "html" + ">" + "<" + "/html>"); // this important
  if ("undefined" === typeof window)
    window = document.parentWindow;
  if ("undefined" === typeof alert)
    alert = function (s) {
      return window.alert(s);
  if ("undefined" === typeof confirm)
    confirm = function (s) {
      return window.confirm(s)
  if ("undefined" === typeof location)
    location = window.location;
  if ("undefined" === typeof navigator)
    navigator = window.navigator;
  if ("undefined" === typeof window.ActiveXObject)
    window.ActiveXObject = ActiveXObject;

  var XMLHttpRequest = new ActiveXObject("WinHttp.WinHttpRequest.5.1");
  var o ="GET", url, false);
  var s = XMLHttpRequest.send();
  return true;
Now a bit of demo code. Notice how we tell JScript what $ means. Possibly that could go in the earlier block of code as yet another global.
var $ = window.$;

// Operation example of a simple jQuery object
WScript.Echo($("<" + "div" + ">").attr("a", "fo").get(0).outerHTML);

// Course alert even I can use.
alert($("<" + "div" + ">").attr("a", "fo").get(0).outerHTML);
(Blogspot didn't like seeing div etc as markup, thus the odd syntax).

© Copyright Bruce M. Axtens, 2015

[JScript] Using jQuery in IE

IE is the browser we all love to hate. It's also scriptable and so inevitably ends up being considered for various tasks.

The following fragment demonstrates the first of two mechanisms I've found for instantiating jQuery in an IE session under script control.
var oIE;
  try {
    oIE = new ActiveXObject("InternetExplorer.Application");
  } catch (errIE) {
  oIE.Visible = false;

  while (oIE.Busy) {

  WScript.Sleep(1000); // could be less

  var DOM = oIE.Document;
  var scr = DOM.createElement('script');
  scr.src = "";

  var $ = DOM.parentWindow.jQuery;
The above code is sliced out of a current project. We navigate to the target, create a script tag, point it at jquery's CDN, and append it to the document's head. Then we define a $ to point to oIE.Document.parentWindow.jQuery.

The same technique can be applied to any page, really. I have a bookmark in my browser that has a name of InjectjQuery and an address of
javascript:var script = document.createElement('script');script.src = ""; document.head.appendChild(script);

The second method for instantiating jQuery in IE can be found at plasticgrammer. I had difficulty with it, but got it working. It has some good things which I'll discuss in the next posting.

© Copyright Bruce M. Axtens, 2015