Domino Code Fragment

Code Name*
Matrix class for DBMS/Web table data		Date*
11/97		Source (or email address if you prefer)*
Jamie Magee
IP address:.18.224.39.32
Description*
Allows retrieval, collation, cross-tabbing, sorting, normalization, HTML conversion, etc. of tabular data from RDBMS or Notes view.		Type*
LotusScript		Categories*
List Processing/Sorting, RDBMS Integration, Reporting/Searching, User Interface (Web), Website Tools
Implementation:
None (plug and play)		Required Client:
Server:
Limitations:
methods with << are implemented. The rest are in progress.		Comments:
Paste into a script library. The LSXDB2 LSX must exist in your Notes directory (for development) and on the server's Notes directory (for runtime). You can get this file free from http://www.lotus.com
Files/Graphics attachments (if applicable): Code:
Uselsx "*LSXDB2"

%REM
CLASS JMatrix
======================
JMatrix = new()
setValuesFromDB2(DB2ResultSet) <<
setValuesFromView(NotesView, rows)
addRow(variant [, position])
removeRow(rowNum)
addColumn(variant [, position])
removeColumn(colNum)
Variant = getRow(row)
Variant = getColumn(col)
appendMatrixColumns(JMatrix)
appendMatrixRows(JMatrix)
JMatrix = crossTab(groupCol, tabCol, dataCol) <<
double = colSum(col) <<
double = colAverage(col) <<
columnNormalize(col) <<
columnTextFormat(col, formatStyle)
sortCols(row)
sortRows(col)
JMatrix = getByRange(startRow, endRow, startCol, endCol)
JMatrix = getByRowsCols(rows, cols)
string = getHTML([rowFormatProfile]) <<
JMatrix = transpose()

CLASS RowFormatProfile
======================
setCellFormatProfile(col)
HeaderFormatProfile(stringArray)
CellFormatProfileArray CellFormats
int NumColumns

CLASS CellFormatProfile
======================
StringArray AttributeList
%END REM

Public Class JMatrix  
    Public numRows As Integer
    Public numColumns As Integer
    Public maxRealColumn As Integer
    Public columnTitles() As String
    Public Data() As String
   
   
    Sub New ()
         numRows = 0
         numColumns = 0
'          Redim Data(1, 1)          ' when left-in, this line causes problem ( B), below
         Redim columnTitles(1)
    End Sub
   
    Sub setValuesFromLSDOResult(res As DB2ResultSet)
         '...this method requires the DB2 LotusScript Extension, NLSXDB2.DLL, in the Options section of this script.
         Me.NumColumns = res.numColumns
         
         '...NumRows does not return an accurate value until the entire result set is fetched into memory.
         '...loop through data and put into table rows
         r = 0
         Do
              r = r+1
              '...NextRow returns the first row, the first time through the loop, then each next row
              res.NextRow
             
              Redim Preserve Me.Data(Me.NumColumns, r)    '...allocate space for new matrix data       (********** B ********) fails at runtime when Redim Data(1,1) exists in New() constructor
               For c = 1 To Me.NumColumns
                   dataval$ = res.getvalue(c)
                   Me.Data(c, r) = dataval$
              Next
         Loop Until res.IsEndOfData
         Me.NumRows = res.NumRows   '...now we can use the NumRows method, which at this point is equal to r
         
         Redim Me.ColumnTitles(Me.NumColumns)  
         For i = 1 To Me.NumColumns      'loop through fieldnames
              Me.ColumnTitles(i) = res.fieldname(i)              
         Next          
    End Sub
   
    Sub addColumn(cData)
         '...add the passed-in array as a new column, in the first available column position
         
         '...determine the new row size requirement for the Matrix
         maxRows = Me.numRows
         arrayRows = Ubound(cData)
         If (arrayRows > maxRows) Then
              maxRows = arrayRows
         End If          
         
         Me.numRows = maxRows                        '...update the row counter          
         Me.numColumns = Me.numColumns + 1   '...update the column counter
          Redim Preserve Me.data(10, 40)                  '...(************ C **********) always works!  (currently hardcoded to high #'s to cover for (A) since (A) fails). But why won't (A) work?
         
         '...copy the data from the passed-in array to the newly allocated space in the Matrix
         For r = 1 To arrayRows
              If (r <= 20) Then Me.data(Me.numColumns, r) = cData(r)    '...if statement used for temporary fix to Redim problem
         Next          
         
    End Sub
   
    Sub concatColumn(t As Integer, s As Integer, sep As String)
    '..t = target column, s = source column, sep = separator
         For r = 1 To Me.numRows
              Me.Data(t, r) = Me.Data(t, r) & sep & Me.Data(s, r)
         Next
    End Sub
   
    Sub appendColumnTitles(cData)
         '...append the passed-in array of values to the existing columnTitles array
         offset = Ubound(Me.columnTitles)  '...can't use Me.NumColumns, because there may not be enough column titles
         numElementsToAdd = Ubound(cData)
          Redim Preserve Me.columnTitles(offset + numElementsToAdd)       '...allocate space for the new columnTitles.
         For c = 1 To numElementsToAdd  
              Me.columnTitles(c + offset) = cData(c)  '...use the offset to start at the next empty position in the column title array
         Next
         Me.numColumns = offset + numElementsToAdd   '...expand the allocation for data to match the allocation for columnTitles
'          Redim Preserve Me.data(0 To Me.numColumns, 0 To Me.numRows)   '...(********* A **********)  always fails to execute: "subscript out of range" but values ARE in range.
    End Sub
   
    Function uniqueColumn(c As Integer) As Variant
         '...returns an array of unique values from a specified column
         Redim ret(0) As String   '...target column
         Dim testValue As String
         For r = 1 To Me.NumRows   ' for each value in the column...
             
              testValue = Me.Data(c, r)     '...new value found in source column
              If (isInArray(testValue, ret)) Then
                    '...do nothing, try next row
              Else
                   newIndex = Ubound(ret) + 1   '...increase from default 0 to the first used index, 1
                   Redim Preserve ret(newIndex)
                   ret(newIndex) = testValue
              End If
         Next
         uniqueColumn = ret
    End Function
   
    Sub setDataByLabel(cVal As String, rVal As String, v As String)
         c = -1
         r = -1
         '...get column number from column value cVal
         For c = 2 To Me.NumColumns   '...because of the way this method works, we can assume that the column won't be the first one.
              If (Me.columnTitles(c) = cVal) Then
                   colNum = c       '...found it!
                   Exit For
              End If        
         Next
         '...get row number from row value rVal
         For r = 1 To Me.NumRows
              If (Me.Data(1, r) = rVal) Then   '...search all rows in the first column only
                   rowNum = r       '...found it!
                    Exit For
              End If        
         Next
         If (c <> -1 And r <> -1) Then   '...only proceed to update the value if both a row and a column were found.
              If Me.Data(c, r) = "" Then
                   Me.Data(c, r) = v         '...set the value to the determined column and row
              Else
                   '...there is already a data value for this item.  Bail out...
                   Print "Sorry, data is not available for this item, please try a different item in your query.  <form><input type=""button"" onClick=""self.history.back()"" value=""<-- Back""></form>"
                   End
              End If
         End If
    End Sub
   
    Function crossTab(groupCol As Integer, tabCol As Integer, dataCol As Integer) As JMatrix
         Set J = New JMatrix()          
         Call J.addColumn(Me.uniqueColumn(groupCol))  '...adds the first column of row labels
         
         J.columnTitles(1) = Me.ColumnTitles(groupCol)          '...   (*********** D ***********) fails when Redim columnTitles(1) Does NOT Exist in New() !!!
          Call J.appendColumnTitles(Me.uniqueColumn(tabCol))  '...add the other column titles from those values in the tab column
         
         For r = 1 To Me.NumRows                             '...insert the data, point by point, according to the col and row labels.
              Call J.setDataByLabel(Me.Data(tabCol, r), Me.Data(groupCol, r), Me.Data(dataCol, r))
         Next
         Set crossTab = J
    End Function
   
    Sub projectValues(c As Integer)
         '...project values for each row of the passed-in column number based on a particular algorithm
         ' proj(X) = BaseValue + (BaseValue * (X- BaseYear) * delta)
         '...where delta = sum[i to (n-1)]  (Y(i) - Y(i-1)) / ((D(i)-D(i-1))*D(i-1))  
                 
         If (Me.maxRealColumn = 0) Then   '...once we start projecting, we need to mark where we projected from so as not to taint the integrity of the real known data
              Me.maxRealColumn = (c - 1)  '..subtract one for the first column since that column is a label, not a data column
         End If
         
         X = Val( Me.columnTitles(c) )  '  the year for which we are projecting
         BaseYear = Val( Me.columnTitles(2) )   '... the first year for which we have known data
         n = Me.maxRealColumn - 1  '...the number of known data points is the last known-data column number, subtracting one to account for the initial label
         For row = 1 To Me.NumRows   '...do all rows in the Matrix
              BaseValue = Me.data(2, row)
             
              sum = 0  '...init the Sigma
              For i = 1 To (n - 1)   '... (c-2) is the number of known data points
                   col = i + 2   '...the algorithm's "i" (which starts at 0 for the first data point) is always two less than our data, which starts at table column #2
                    quotient = Val( Me.columnTitles(col) ) - Val( Me.columnTitles(col - 1) )
                   divisor =  ( Val( Me.data(col, row) ) - Val( Me.data(col - 1, row) ) ) * Val( Me.data(col - 1, row) )
                   If divisor = 0 Then divisor = 0.001  '...avoid division by zero
                   sum = sum + (quotient/divisor)
              Next
              delta = sum / (n - 1)              
              YearDiff = X - BaseYear
              projection = BaseValue + ( BaseValue * (YearDiff*delta) )
              Me.Data(c, row) = Format$(Fix(projection), "###,###,###,###")        
         Next
         
    End Sub
   
    Function getColumnSum(c As Integer) As Double
         For r = 1 To Me.NumRows
              getColumnSum = getColumnSum + Val(Me.Data(c, r))
         Next
    End Function
   
    Function columnAverage(c As Integer) As Double   '...not used
         ' not needed
    End Function
   
    Function getNormalizedValue(c As Integer, r As Integer)   '...not used
          sum = Me.getColumnSum(c)          
         getNormalizedValue = Cstr(100 * Val(Me.Data(c, r)) / sum )   '...(100*value)/sum              
    End Function
   
    Sub columnNormalize(c As Integer) '..not used
         sum = Me.getColumnSum(c)
         For r = 1 To Me.NumRows
              Me.Data(c, r) = Cstr(100 * Val(Me.Data(c, r)) / sum )   '...replace value with (100*value)/sum
         Next
    End Sub    
   
    Function getJChartDataParameters(t As String) As Variant
         Redim ret(0) As String
         Dim c As Integer
         labelCol = 1 '...columns that contains the labels, such that all columns after it are data
         NumDataSeries = Me.numColumns - labelCol   '...the number of columns of data
         Select Case t
         Case "PIE":
             
              Redim Preserve ret(NumDataSeries - 1)               '...allocate all space that will be needed in the returned array (-1 due to index starts at 0)
              For c = labelCol + 1 To Me.numColumns         '...walk through the data columns
                   
                   nonzerocount = 0
                   For r = 1 To Me.numRows
                        If Val(Me.data(c, r)) <> 0 Then
                             nonzerocount = nonzerocount + 1
                        End If
                   Next
                   temp = "ARRAY '' " & Cstr(nonzerocount + 1)  & " 1 "    '...init
                   temp = temp & " '' '' " & Cstr(nonzerocount + 1) & " 1 "
                   sum = Me.getColumnSum(c)       '...use this sum for determining normalized values                    
                   For r = 1 To Me.numRows                           '...for each non-zero row in the current datacol, get label & normalized value
                        If Val(Me.data(c, r)) <> 0 Then
                             temp = temp & " '" & Me.data(labelCol, r) & "' " & Format$(100 * Val(Me.Data(c, r)) / sum, "##.0####" )  & " "    '... 'Flagstaff' 24.6                              
                        End If                        
                   Next
                    temp = temp & "'Other' 0.00000 "
                   index = c - labelCol - 1   '...the index of the output, first iteration is 0
                   ret(index) = temp
              Next
             
'            ARRAY '' 4 1  
'            ''   '' 1 3  
'            'User' 20   'System' 40  'mm' 38  'Idle' 40
%REM
              ret(0) = "ARRAY ''  4 1 '' '' 1 3  'Flagstaff' 24.6 'Phoenix' 31.1 'Tucson' 30.6"
              Redim Preserve ret(1)
              ret(1) = "ARRAY ''  4 1 '' '' 1 3  'Flagstaff' 50.6 'Phoenix' 20.1 'Tucson' 30.6"
%END REM
             
         Case "BAR", "PLOT":
'            ARRAY 3 4                  number of items, number of series per item
'            ''
'            1.0 2.0 3.0 4.0                           min and max Y axis
'            'Dallas' 150.0 175.0 160.0 170.0   legend name and color, data
'            'Boston' 125.0 100.0 225.0 300.0
'            'Chicago' 113.0 110.0 200.0 310.0
             
             
              temp = "ARRAY " & Str$(Me.numRows) & " " & Str$(Me.numColumns - labelCol) & " "
               For c = labelCol + 1 To Me.numColumns         '...walk through the data columns
                   temp = temp & "'" & Me.columnTitles(c) & "' "
                   intlist = intlist & Str$(c - labelCol) & ".0 "
              Next
              temp = temp & intlist
             
              For r = 1 To Me.numRows                           '...for each row in the current datacol, get label & normalized value
                   temp = temp & " '" & Me.data(labelCol, r) & "' "     '... 'Flagstaff' ...
                   For c = labelCol + 1 To Me.numColumns  
                        temp = temp & Format$(Me.Data(c, r), "#0.0#" )  & " "    '...24.6 35.4 48.1
                   Next                        
              Next
             
              ret(0) = temp
             
           '   ret(0) = "ARRAY  3 1 '' 1.0  'Flagstaff' 24.6  'Phoenix' 31.1  'Tucson' 30.6"
             
         Case Else:
              ret(0) = "ARRAY  3 1 '' 1.0  'Flagstaff' 24.6  'Phoenix' 31.1  'Tucson' 30.6"
          End Select
         getJChartDataParameters = ret
    End Function    
   
    Function getHTML() As String
         Dim html As String
         html = html & "<TABLE BORDER=1 CELLPADDING=3>"
         
         ' ====== Titles ==========
         html = html & "<TR>"
         For c = 1 To Me.NumColumns      'loop through fieldnames and send to table header
              html = html & "<TH>"
              html = html & Me.columnTitles(c)
              html = html & "</TH>"
         Next                            
         html = html & "</TR>"
         
         ' ======== Data =========
         html = html & "<TR>"
         For r = 1 To Me.NumRows                '...loop through rows
              For c = 1 To Me.NumColumns         '...loop through columns for each row
                   If c > 1 Then alignString$ = " align=right" Else alignString$ = ""
                   html = html & "<TD" & alignString$ & ">"
                   html = html & Format$(Me.Data(c, r), "###,###,###,###.##")
                    html = html & "</TD>"
              Next c
              html = html & "</TR>"
         Next r
         html = html & "</TR>"         '...terminate the row
         
         html = html & "</TABLE>"   '...terminate the table
         getHTML = html    
    End Function
   
End Class