[QGIS][2.x] Example of iterating layers, attributes and features

layermap = QgsMapLayerRegistry.instance().mapLayers()
   
for (name,layer) in layermap.iteritems():
    if layer.type() != QgsVectorLayer.VectorLayer:
        continue
     
    if "SampleLayer" in layer.name():
        dP = layer.dataProvider()
     
        for attr in dP.fields():
            if (attr.name() == "SampleAttr"):
                SampleAttrId = dP.fieldNameIndex(attr.name())
                break
 
 
    layer.select(dP.attributeIndexes())
     
    FetSet = layer.getFeatures()
 
    for feat in FetSet:
        SampleAttrStr = str(feat[SampleAttrId])
        SampleAttrValue = float(str(feat[SampleAttrId]))

[VBA] Ceiling

https://github.com/walter426/VbaUtilities/blob/master/MathUtilities.bas

Public Function Ceiling(X)
    Ceiling = Int(X) - (X - Int(X) > 0)
End Function

[VBA] Generate a concatenated string of related records (SQL Query Use)

Reference: http://allenbrowne.com/func-concat.html

https://github.com/walter426/VbaUtilities/
Useful user-defined SQL Query function to do record concatenation.

Example:
SELECT [2G_Bcch].CELL, First(ConcatRelated("bcchno"," 2G_HO_Bcch","CELL = """ & [2G_Bcch].[CELL] & """","",";")) AS BcchSet
FROM 2G_Bcch
GROUP BY [2G_Bcch].CELL;

Below is the version added a little bit of modification to suit to my vba utilities,

Code:
Public Function ConcatRelated(strField As String, _
    strTable As String, _
    Optional strWhere As String, _
    Optional strOrderBy As String, _
    Optional strSeparator = ", ") As Variant
On Error GoTo Err_ConcatRelated
    'Purpose:   Generate a concatenated string of related records.
    'Return:    String variant, or Null if no matches.
    'Arguments: strField = name of field to get results from and concatenate.
    '           strTable = name of a table or query.
    '           strWhere = WHERE clause to choose the right values.
    '           strOrderBy = ORDER BY clause, for sorting the values.
    '           strSeparator = characters to use between the concatenated values.
    'Notes:     1. Use square brackets around field/table names with spaces or odd characters.
    '           2. strField can be a Multi-valued field (A2007 and later), but strOrderBy cannot.
    '           3. Nulls are omitted, zero-length strings (ZLSs) are returned as ZLSs.
    '           4. Returning more than 255 characters to a recordset triggers this Access bug:
    '               http://allenbrowne.com/bug-16.html
    Dim rs As DAO.Recordset         'Related records
    Dim rsMV As DAO.Recordset       'Multi-valued field recordset
    Dim strSql As String            'SQL statement
    Dim strOut As String            'Output string to concatenate to.
    Dim lngLen As Long              'Length of string.
    Dim bIsMultiValue As Boolean    'Flag if strField is a multi-valued field.
    
    'Initialize to Null
    ConcatRelated = Null
    
    'Build SQL string, and get the records.
    strSql = "SELECT " & strField & " FROM " & strTable
    If strWhere <> vbNullString Then
        strSql = strSql & " WHERE " & strWhere
    End If
    If strOrderBy <> vbNullString Then
        strSql = strSql & " ORDER BY " & strOrderBy
    End If
    Set rs = DBEngine(0)(0).OpenRecordset(strSql, dbOpenDynaset)
    'Determine if the requested field is multi-valued (Type is above 100.)
    bIsMultiValue = (rs(0).Type > 100)
    
    'Loop through the matching records
    Do While Not rs.EOF
        If bIsMultiValue Then
            'For multi-valued field, loop through the values
            Set rsMV = rs(0).Value
            Do While Not rsMV.EOF
                If Not IsNull(rsMV(0)) Then
                    strOut = strOut & rsMV(0) & strSeparator
                End If
                rsMV.MoveNext
            Loop
            Set rsMV = Nothing
        ElseIf Not IsNull(rs(0)) Then
            strOut = strOut & rs(0) & strSeparator
        End If
        rs.MoveNext
    Loop
    rs.Close
    
    'Return the string without the trailing separator.
    lngLen = Len(strOut) - Len(strSeparator)
    If lngLen > 0 Then
        ConcatRelated = Left(strOut, lngLen)
    End If

Exit_ConcatRelated:
    'Clean up
    Set rsMV = Nothing
    Set rs = Nothing
    Exit Function

Err_ConcatRelated:
    Call ShowMsgBox("Error " & Err.Number & ": " & Err.Description, vbExclamation, "ConcatRelated()")
    Resume Exit_ConcatRelated
    
End Function

[PyQt] Create Widget Grid(2D-array)

https://github.com/walter426/PyQtUtilities/

There are many GUI which require to display a group of widget(e.g. button, checkbox...) in a grid format.

Below is  an user-defined PyQt object to handle this kind of requirement,

Example:

self.WidgetList_QWG = QWidgetGrid('QCheckBox', '', Tbl_WidgetArgu_set, GridDirection = 0, MaxRowCnt = 15)
self.WidgetListt_scrollArea.setWidget(self.WidgetList_QWG)

Code:

from PyQt4.QtCore import *
from PyQt4.QtGui import *

import math


class QWidgetGrid(QWidget):
    def __init__(self, WidgetType, WidgetTypeName, WidgetArguSet, GridDirection = 0, MaxRowCnt = 0, MaxColCnt = 0):
        QWidget.__init__(self)
        
        if GridDirection > 1:
            return
        
        if MaxRowCnt == 0 and MaxColCnt == 0:
            return
            
        TblCnt = len(WidgetArguSet)
        
        if TblCnt <= 0:
            return
        
        
        if MaxRowCnt > 0 and MaxColCnt == 0:
            MaxColCnt = int(math.ceil(float(TblCnt)/float(MaxRowCnt)))
            
        elif MaxColCnt > 0 and MaxRowCnt == 0:
            MaxRowCnt = int(math.ceil(float(TblCnt)/float(MaxColCnt)))
                
        self.QGL = QGridLayout()
        

        tbl_idx = 0
        
        #From Top to Bottom, than Left to Right
        if GridDirection == 0:
            ColCnt = int(math.ceil(float(TblCnt)/float(MaxRowCnt)))
            
            for col_idx in range(0, ColCnt):
                RowCnt = MaxRowCnt

                if col_idx >= ColCnt - 1 and (TblCnt % MaxRowCnt) > 0:
                    RowCnt = TblCnt % MaxRowCnt
                
                for row_idx in range(0, RowCnt):
                    str_Widget_curr =  'self.' + WidgetTypeName + '_' + str(tbl_idx)
                    str_CreateWidget = str_Widget_curr + ' = ' + WidgetType + '('
                    
                    for k in range(0, len(WidgetArguSet[tbl_idx])):
                        str_CreateWidget += WidgetArguSet[tbl_idx][k] + ', '
                    
                    
                    str_CreateWidget = str_CreateWidget.rstrip(',') + ')'
                    exec(str_CreateWidget)     
                    exec('self.QGL.addWidget(' + str_Widget_curr + ', ' + str(row_idx) + ', ' + str(col_idx) + ')')
                    
                    tbl_idx += 1
        
        
        #From Left to Right, Top to Bottom
        elif GridDirection == 1:
            RowCnt = int(math.ceil(float(TblCnt)/float(MaxColCnt)))
            
            for row_idx in range(0, RowCnt):
                ColCnt = MaxColCnt

                if row_idx >= RowCnt - 1 and (TblCnt % MaxColCnt) > 0:
                    ColCnt = TblCnt % MaxColCnt
                
                for col_idx in range(0, ColCnt):
                    str_Widget_curr =  'self.' + WidgetTypeName + '_' + str(tbl_idx)
                    str_CreateWidget = str_Widget_curr + ' = ' + WidgetType + '('
                    
                    for k in range(0, len(WidgetArguSet[tbl_idx])):
                        str_CreateWidget += WidgetArguSet[tbl_idx][k] + ', '
                        
                        
                    str_CreateWidget = str_CreateWidget.rstrip(',') + ')'
                    exec(str_Widget_curr + ' = ' + WidgetType +'(' + str_CreateWidget + ')')     
                    exec('self.QGL.addWidget(' + str_Widget_curr + ', ' + str(row_idx) + ', ' + str(col_idx) + ')')
                    
                    tbl_idx += 1
        
        
        self.setLayout(self.QGL)
    
    def __del__(self):
        return

[VBA] Delete an Array Element

Public Sub DeleteArrayItem(arr As Variant, index As Long)
    Dim i As Long
    
    For i = index To UBound(arr) - 1
        arr(i) = arr(i + 1)
    Next
    
    ' VB will convert this to 0 or to an empty string.
    arr(UBound(arr)) = Empty
    ReDim Preserve arr(LBound(arr) To UBound(arr) - 1)
    
End Sub

[VBA] Concatenate multiple tables of identical structure

https://github.com/walter426/VbaUtilities/blob/master/SqlUtilities.bas

'Create table which is cancatenated from multiple tables of the same structure
Public Function CreateTbl_ConcatTbls(Tbl_src_Set As Variant, Tbl_des_name As String, Optional Type_Set As Variant = "") As String
    On Error GoTo Err_CreateTbl_ConcatTbls
   
    Dim FailedReason As String

    If UBound(Tbl_src_Set) < 0 Then
        FailedReason = "No table in the table set"
        GoTo Exit_CreateTbl_ConcatTbls
    End If

   
    Dim Tbl_src_name As Variant
   
    For Each Tbl_src_name In Tbl_src_Set
        If TableExist(Tbl_src_name & "") = False Then
            FailedReason = Tbl_src_name & " does not exist!"
            GoTo Exit_CreateTbl_ConcatTbls
        End If
   
    Next
   

    'Initialize Tbl_des
    DelTable (Tbl_des_name)
   
    Dim SQL_cmd As String
   
    Tbl_src_name = Tbl_src_Set(0)
   
    SQL_cmd = "SELECT " & Chr(34) & "null" & Chr(34) & " AS [Type], " & Tbl_src_name & ".* " & vbCrLf & _
                "INTO " & Tbl_des_name & " " & vbCrLf & _
                "FROM " & Tbl_src_name & " " & vbCrLf & _
                "WHERE 1 = 0 " & vbCrLf & _
                ";"
               
    RunSQL_CmdWithoutWarning (SQL_cmd)


    'Start Append
    Dim tbl_idx As Integer
    Dim SQL_Seq_Type As String
   
    For tbl_idx = 0 To UBound(Tbl_src_Set)
        Tbl_src_name = Tbl_src_Set(tbl_idx)
       
        If VarType(Type_Set) > vbArray And Type_Set(tbl_idx) = "" Then
            SQL_Seq_Type = ""
        Else
            SQL_Seq_Type = Chr(34) & Type_Set(tbl_idx) & Chr(34) & " AS [Type], "
        End If
       
        SQL_cmd = "INSERT INTO " & Tbl_des_name & " " & vbCrLf & _
                    "SELECT " & SQL_Seq_Type & "[" & Tbl_src_name & "].* " & vbCrLf & _
                    "FROM [" & Tbl_src_name & "] " & vbCrLf & _
                    ";"
       
        RunSQL_CmdWithoutWarning (SQL_cmd)
       
    Next
   
   
    If UBound(Type_Set) < 0 Then
        SQL_cmd = "ALTER TABLE [" & Tbl_des_name & "] " & vbCrLf & _
                    "DROP COLUMN [Type]" & vbCrLf & _
                    ";"

        RunSQL_CmdWithoutWarning (SQL_cmd)
       
    End If
   
   
Exit_CreateTbl_ConcatTbls:
    CreateTbl_ConcatTbls = FailedReason
    Exit Function

Err_CreateTbl_ConcatTbls:
    FailedReason = Err.Description
    Resume Exit_CreateTbl_ConcatTbls
   
End Function

[VBA] Logarithm of base 10

https://github.com/walter426/VbaUtilities/blob/master/MathUtilities.bas

As there is not built-in function for logarithm of base 10, so it is required to build it from the default natural  Logarithm function in VBA

Public Function Log10(X)
    Log10 = Log(X) / Log(10#)
End Function

[VBA] Get Link Table connection Info

A function to obtain link table connection information such as 'link specification', current path...

'Get Link Table connection Info
Public Function GetLinkTblConnInfo(Tbl_name As String, param As String) As String
    On Error GoTo Exit_GetLinkTblConnInfo
    
    Dim LinkTblConnInfo As Variant
    LinkTblConnInfo = SplitStrIntoArray(CurrentDb.TableDefs(Tbl_name).Connect, ";")

    Dim param_idx As Integer
    Dim LinkTblConnParam As String
    
    param = param & "="

    For param_idx = 0 To UBound(LinkTblConnInfo)
        LinkTblConnParam = LinkTblConnInfo(param_idx)

        If Left(LinkTblConnParam, Len(param)) = param Then
            GetLinkTblConnInfo = Right(LinkTblConnParam, Len(LinkTblConnParam) - Len(param))
            Exit For
        End If
    Next param_idx
    
    
Exit_GetLinkTblConnInfo:
    Exit Function

Err_GetLinkTblConnInfo:
    ShowMsgBox (Err.Description)
    GetLinkTblConnInfo = ""
    Resume Exit_GetLinkTblConnInfo
    
End Function

[VBA] Get the current path of a link table

'Get the current path of a link table
Public Function GetLinkTblPath(Tbl_name As String) As String
    On Error GoTo Exit_GetLinkTblPath
    
    Dim LinkTblPath As String
    
    LinkTblPath = CurrentDb.TableDefs(Tbl_name).Connect
    LinkTblPath = Right(LinkTblPath, Len(LinkTblPath) - (InStr(1, LinkTblPath, "DATABASE=") + 8)) & "\" & CurrentDb.TableDefs(Tbl_name).SourceTableName
    
    GetLinkTblPath = LinkTblPath
    
Exit_GetLinkTblPath:
    Exit Function

Err_GetLinkTblPath:
    ShowMsgBox (Err.Description)
    GetLinkTblPath = ""
    Resume Exit_GetLinkTblPath
    
End Function

[QGIS] Draw vector layer features correctly on the mapCanvas

Since the CRS stored in a vector layer may not be the same as the one which the current project using.
It must convert the coordinates of features first for correct drawing.

Below is an example to do it.

from qgis.core import *
from qgis.gui import *

mapCanvas = iface.mapCanvas
RubberBand = QgsRubberBand(mapCanvas, False)

 DrawVectorsInCandList(mapCanvas, CandList, VL, color, RubberBand)

self.mapCanvas.refresh()


def DrawVectorsInCandList(mapCanvas, CandList, VL, color, RubberBand_l):
        if len(CandList) <= 0: #to cater for -1 or +1 frequency
            RubberBand_l.reset(False)
            return
        
        str_find = ""
        
        for item in CandList:
            str_find = str_find + 'or CandID=\'' + item + '\''       
        
        str_find = str_find.lstrip('or ')
                
        VL.setSubsetString(str_find)
        VL.invertSelection()
        VL.setSubsetString("")

        featlist = VL.selectedFeatures()
        
        if VL.selectedFeatureCount == 0:
           return

        fNIdx_CandID = VL.fieldNameIndex("CandID")
        Qgs_MPL = QgsGeometry().asMultiPolyline()
        
        
        VL_crs = QgsCoordinateReferenceSystem()
        VL_crs.createFromEpsg(VL.crs().epsg())
        mapCanvas_crs = mapCanvas.mapRenderer().destinationCrs()
        
        for feature in featlist:
            QgsPoint_O = feature.geometry().vertexAt(0)
            QgsPoint_O = CoorTransform(QgsPoint_O, VL_crs, mapCanvas_crs)

            QgsPoint_D = feature.geometry().vertexAt(1)
            QgsPoint_D = CoorTransform(QgsPoint_D, VL_crs, mapCanvas_crs)

            Qgs_MPL.append([QgsPoint_O, QgsPoint_D])
        
        
        RubberBand_l.reset(False)
        RubberBand_l.setColor(color)
        RubberBand_l.setWidth(2)
        RubberBand_l.setToGeometry(QgsGeometry.fromMultiPolyline(Qgs_MPL), None)
        RubberBand_l.show()

[QGIS] Coordinate Transformation

https://github.com/walter426/QgisUtilites/blob/master/QgsUtilities.py

It is a very useful and frequently used light tool to do coordinate transformation from a source CRS(Coordinate Reference System) to a destination CRS.

Code:

from qgis.core import *

def CoorTransformByCrsId(point, crs_id_src, crs_id_des):
    crs_src = QgsCoordinateReferenceSystem()
    crs_src.createFromSrid(crs_id_src)

    crs_des = QgsCoordinateReferenceSystem()
    crs_des.createFromSrid(crs_id_des)

    transformer = QgsCoordinateTransform(crs_src, crs_des)
    pt = transformer.transform(point)
    
    return pt


def CoorTransform(point, crs_src, crs_des):
    transformer = QgsCoordinateTransform(crs_src, crs_des)
    pt = transformer.transform(point)
    
    return pt

[VBA] Send shell commands keeping alive to Unix via Telnet

Below is an example to make use of my function, Shell_SendKeysWithTimeout to send shell command to remote Unix server via telnet, and keep the command running even after disconnection(nohup).

Code:

    Dim FailedReason As String
    
    Dim oShell As Object
    Set oShell = CreateObject("WScript.Shell")

    Dim CmdTxt As String
    
    CmdTxt = "telnet " & IP & vbCrLf & _
                  user & vbCrLf & _
                  pw & vbCrLf & _
                "nohup sample_script " & vbCrLf & _
                ""
    
    oShell.Run ("cmd.exe")
    Sleep 1000
    
    FailedReason = Shell_SendKeysWithTimeout(oShell, CmdTxt, 1000)

[VBA] Split a Text File into multiple text files of specified row count

https://github.com/walter426/VbaUtilities/blob/master/FileSysUtilities.bas

The intention to write this function is to split a text files of row count more than 65535 into multiple text files,
so that it is able to modify those files further by Excel which has limit of 65536 rows on reading any files.
Therefore, This function has the option to add header rows from the original files.


'Split a Text File into multiple text files of specified row count(default: 65535)
Public Function SplitTextFile(src As String, Optional des_fmt As String, Optional RowCntPerFile As Long = 65535, Optional file_idx_start As Integer = 0, Optional NumOfHdrRows As Long = 0, Optional DeleteSrc As Boolean = False) As String
    On Error GoTo Err_SplitTextFile
    
    Dim FailedReason As String


    If Len(Dir(src)) = 0 Then
        FailedReason = src
        GoTo Exit_SplitTextFile
    End If

    If RowCntPerFile < NumOfHdrRows + 1 Then
        FailedReason = "RowCntPerFile < NumOfHdrRows + 1"
        GoTo Exit_SplitTextFile
    End If


    'if no need to split, return
    Dim RowCnt_src As Long
    RowCnt_src = CountRowsInText(src)
    
    If RowCnt_src <= RowCntPerFile Then
        GoTo Exit_SplitTextFile
    End If
    
    
    'Check whether there exists files which name is same to the splitted files
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim des_dir As String
    Dim des_name As String
    Dim des_ext As String
    Dim des_path As String
    
    des_dir = fso.GetParentFolderName(src)
    des_name = fso.GetFileName(src)
    des_ext = fso.GetExtensionName(src)

    If des_fmt = "" Then
        des_fmt = Left(des_name, Len(des_name) - Len("." & des_ext)) & "_*"
    End If

    
    Dim NumOfSplit As Integer
    
    If RowCnt_src <= RowCntPerFile Then
        NumOfSplit = 0
    Else
        NumOfSplit = Int((RowCnt_src - RowCntPerFile) / (RowCntPerFile + 1 - NumOfHdrRows)) + 1
    End If
    
    
    Dim file_idx_end As Integer
    file_idx_end = file_idx_start + NumOfSplit 'Int(RowCnt_src / (RowCntPerFile + 1 - NumOfHdrRows))
    
    
    Dim file_idx As Integer
    
    For file_idx = file_idx_start To file_idx_end
        des_path = des_dir & "\" & Replace(des_fmt, "*", str(file_idx)) & "." & des_ext
        
        If Len(Dir(des_path)) > 0 Then
            Exit For
        End If
        
    Next file_idx
    
    
    If Len(Dir(des_path)) > 0 Then
        FailedReason = des_path
        GoTo Exit_SplitTextFile
    End If
    
    
    
    'Obtain header rows for later files and create the first splitted file
    Dim File_src As Object
    Dim FileNum_des As Integer
    Dim str_line As String
    Dim HdrRows As String

    Set File_src = fso.OpenTextFile(src, 1)
    des_path = des_dir & "\" & Replace(des_fmt, "*", str(file_idx_start)) & "." & des_ext
    FileNum_des = FreeFile
    Open des_path For Output As #FileNum_des
    
    RowCnt = 0
    
    Do Until RowCnt >= NumOfHdrRows Or File_src.AtEndOfStream = True
        RowCnt = RowCnt + 1
        str_line = File_src.ReadLine
        Print #FileNum_des, str_line
        HdrRows = HdrRows & str_line
        
    Loop

    
    Do Until RowCnt >= RowCntPerFile Or File_src.AtEndOfStream = True
        RowCnt = RowCnt + 1
        Print #FileNum_des, File_src.ReadLine
        
    Loop
    
    Close #FileNum_des
    

    'Start to split
    For file_idx = file_idx_start + 1 To file_idx_end
        If File_src.AtEndOfStream = True Then
            Exit For
        End If
            
        des_path = des_dir & "\" & Replace(des_fmt, "*", str(file_idx)) & "." & des_ext
        FileNum_des = FreeFile
        Open des_path For Output As #FileNum_des

        RowCnt = NumOfHdrRows
        Print #FileNum_des, HdrRows

        Do Until RowCnt >= RowCntPerFile Or File_src.AtEndOfStream = True
            RowCnt = RowCnt + 1
            Print #FileNum_des, File_src.ReadLine
            
        Loop

        Close #FileNum_des
        
    Next file_idx

    
    File_src.Close


    If DeleteSrc = True Then
        Kill src
    End If
    
    
Exit_SplitTextFile:
    SplitTextFile = FailedReason
    Exit Function

Err_SplitTextFile:
    FailedReason = Err.Description
    Resume Exit_SplitTextFile
    
End Function

[VBA] Count Row Number of a text file

https://github.com/walter426/VbaUtilities/blob/master/FileSysUtilities.bas

Public Function CountRowsInText(file_name As String) As Long
    On Error GoTo Err_CountRowsInText
    
    Dim fso As Object
    Dim File As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set File = fso.OpenTextFile(file_name, 1)


    Dim RowCnt As Long
    Dim str_line As String
    
    RowCnt = 0

    Do Until File.AtEndOfStream = True
        RowCnt = RowCnt + 1
        str_line = File.ReadLine
        
    Loop


    File.Close


Exit_CountRowsInText:
    CountRowsInText = RowCnt
    Exit Function

Err_CountRowsInText:
    RowCnt = -1
    Call ShowMsgBox(Err.Description)
    Resume Exit_CountRowsInText

End Function

[VBA] Append items to an Array

https://github.com/walter426/VbaUtilities/blob/master/ArrayUtilities.bas

As there is no build-in function to append items to an array in VBA, I made below function to do such thing.

'Append items to an Array
'Append items to an Array
Public Function AppendArray(Array_src As Variant, Array_append As Variant) As String
    Dim FailedReason As String

    Dim i As Long
    
    For i = LBound(Array_append) To UBound(Array_append)
        ReDim Preserve Array_src(LBound(Array_src) To UBound(Array_src) + 1)
        Array_src(UBound(Array_src)) = Array_append(i)
    Next i


Exit_AppendArray:
    AppendArray = FailedReason
    Exit Function

Err_AppendArray:
    FailedReason = Err.Description
    Resume Exit_AppendArray
    
End Function

[Matlab] Random Multi-Regions Symbol Generator

https://github.com/walter426/Matlab_DSMA_Utilities/blob/master/DSMA_Utilities/utils/RandomMRS_Generator.m

It is also a side-product of the M-Ary Quadrature Signal Modulation Decision Region Generator, http://waltertech426.blogspot.hk/2013/08/matlab-m-ary-quadrature-signal.html

The use of it is to generate Random Multi-Regions(e.g. Quafrature) Symbol within a limited range. 

 



Not even for twe dimensional and four symbols, this generator is able to generate a symbol set of any number of symbols of dimensions.

[Matlab] M-Ary Signal Modulation Bit Error Rate Simulator

https://github.com/walter426/Matlab_DSMA_Utilities/tree/master/DSMA_Utilities/M_Ary_SMBER_Simulator

This stuff is a side-product of the M-Ary Quadrature Signal Modulation Decision Region Generator, http://waltertech426.blogspot.hk/2013/08/matlab-m-ary-quadrature-signal.html

Two Symbol Coding Schemes are considered in this program, Binary Code and Gray Code.

Actually, this BER Simulator can apply to signal set of space space dimensions more than two.

[VBA] Replace String in a range of a worksheet that enclose any excel error in a function

Since the Excel range.Replace function in VBA will prompt its own error(e.g. cannot find any string to replace) to halt the program that cannot bypass by "On error resume next". Therefore, it must place the range.Replace function into a function for ignoring the error.


'Replace String in a range of a worksheet that enclose any excel error in a function
Public Function ReplaceStrInWsRng(oWsRng As Range, What As Variant, Replacement As Variant, Optional LookAt As Variant, Optional SearchOrder As Variant, Optional MatchCase As Variant, Optional MatchByte As Variant, Optional SearchFormat As Variant, Optional ReplaceFormat As Variant) As String
    On Error GoTo Err_ReplaceStrInWsRng
    
    Dim FailedReason As String
    
    With oWsRng
        .Application.DisplayAlerts = False

        .Replace What, Replacement, LookAt, SearchOrder, MatchCase, MatchByte, SearchFormat, ReplaceFormat

        .Application.DisplayAlerts = True
        
    End With '.oWsRng


Exit_ReplaceStrInWsRng:
    ReplaceStrInWsRng = FailedReason
    Exit Function

Err_ReplaceStrInWsRng:
    FailedReason = Err.Description
    Resume Exit_ReplaceStrInWsRng
    
End Function

[Matlab] M-Ary Quadrature Signal Modulation Decision Region Generator

https://github.com/walter426/Matlab_DSMA_Utilities/tree/master/DSMA_Utilities/M_Ary_QSMDR_Generator


 As mentioned in the title, it is a Digital Signal Processing stuff, but it can be applied to other fields which need to determine any 2D decision regions... (It sounds shit to laymen...)

Below is a brief lesson for background started from the point of view under signal processing.

Fig 1: Constellation Diagram

During a physical communication, a set of signals called Modulation Scheme is used to indicate information(e.g. '00', '11', '10...) to be transmitted. The signal in a Modulation Scheme can be represented by a set of orthogonal signals called Signal Space. The number of the orthogonal  signals is thus the number of dimensions of the signal space. Then, a Modulation Scheme can be represented as a set of point symbol in the Signal Space that is called a Constellation Diagram.

Fig.2: Decision Region

During a transmission, it is normal that the signal will suffer noise from the environment, that represents as a displacement of symbol in the Signal Space. If Noise is high enough, the transmitted symbol may be shifted to a location close to other symbol so that the receiver will de-modulate out wrong symbol. So it is important to keep sufficient distance between each signal symbol pairs in the Modulation Scheme in the signal space if noise is quite high. The distance implies each symbol has its own optimal decision region in the signal space to minimize the Symbol Error Ratio and thus the Bit Error Rate.



Now make a break of the lesson, let me recall the aim of the M-Ary Quadrature Signal Modulation Decision Region Generator(M-Ary QSMDR Generator). The aim of the M-Ary QSMDR Generator is to "Draw Optimal Decision Regions of any number of Signal Symbol in a 2-Dimensional Signal Space".


Below is the brief description of the main project files,
M_Ary_QSMDR_Generator.m: Create Arguments(e.g. Signal Set, Probability Set) for SignalSymbolDecisionRegionGenerator.m
SignalSymbolDecisionRegionGenerator.m: Create and Draw the Decision Regions of the input Signal Symbol.
SignalSymbolDecisionBdry.m: Create Decision Boundary between two signal symbols with given probabilities of the symbols and the Additive White Gaussian Noise(AWGN) .


Based on previous background and description, it's time to explain the algorithm which is implemented in SignalSymbolDecisionRegionGenerator.m.

A. Create Boundary Line between Signal Symbol pair:
- Every Signal Symbol pair are put into SignalSymbolDecisionBdry.m to create its Decision Boundary based on below criteria.

Fig 3. Decision Boundary Criteria

Fig 4: Decision Regions before truncation

After all boundary line are drawn, it is obvious that every signal symbol need the boundary segments closest to it only. The other boundary segments can be truncated on the diagram.

At this step, the optimal decision region problem becomes a Geometry problem. 

B. Cut unnecessary boundary segment
To be honest, it is not easy to archive this task. Fortunately, I found out this is possible if treat the lines in the constellation diagram as vectors. By comparing the angles between those vectors, it is possible to get which boundary segments are closest to the symbol. Below is the Vector Angle Comparison Criteria.

By above Four criteria, the unnecessary boundary segments is able to be determined, and then truncated on the Decision Region diagram.


Below are some examples of the Decision Region generated,

Comment:
This stuff is the most difficult project I have ever made before...
The difficulty is on the discovery on the relations between symbols and their intercepted boundary lines...

[VBA] Do Grouping Function on the Access Table in an efficiently way

Columns in a SQL table to be grouped(e.g.sum, avg, count, max, min...) required a new name, otherwise it is required to specified the source table in the field selection. As it is often necessary to  keep the original name. Therefore I wrote below function to do the Grouping Function on the Access Table in an efficiently way


Ref: https://github.com/walter426/VbaUtilities/blob/master/SqlUtilities.bas
       https://github.com/walter426/VbaUtilities/blob/master/StrUtilities.bas
       https://github.com/walter426/VbaUtilities/blob/master/AccessObjUtilities.bas

'Create Table of group function, there is a default Group function for all columns, columns can be specified to different group fucntion
Public Function CreateTbl_Group(Tbl_input_name As String, Tbl_output_name As String, Str_Col_Group As String, Optional Str_GroupFunc_all As String = "", Optional GF_all_dbTypes As Variant = "", Optional Str_Col_UnSelected As String = "", Optional ByVal GroupFunc_Col_Pairs As Variant = "", Optional SQL_Seg_Where As String = "", Optional Str_Col_Order As String = "") As String
    On Error GoTo Err_CreateTbl_Group
    
    Dim FailedReason As String
    
    If TableValid(Tbl_input_name) = False Then
        FailedReason = Tbl_input_name & " is not valid!"
        GoTo Exit_CreateTbl_Group
    End If

    If Len(Str_Col_Group) = 0 Then
        FailedReason = "No Any Group Columns"
        GoTo Exit_CreateTbl_Group
    End If

    
    If Str_GroupFunc_all <> "" Then
        If UBound(GF_all_dbTypes) < 0 Then
            FailedReason = "No db Type is assigned for the general group function"
            GoTo Exit_CreateTbl_Group
        End If
    End If


    If VarType(GroupFunc_Col_Pairs) <> vbArray + vbVariant Then
        If Str_GroupFunc_all = "" Then
            FailedReason = "No Any Group Functions for all or specified columns"
            GoTo Exit_CreateTbl_Group
        Else
            GroupFunc_Col_Pairs = Array()
        End If
    End If
         
    Dim GF_C_P_idx As Integer

    For GF_C_P_idx = 0 To UBound(GroupFunc_Col_Pairs)
        GroupFunc_Col_Pairs(GF_C_P_idx)(1) = SplitStrIntoArray(GroupFunc_Col_Pairs(GF_C_P_idx)(1) & "", ",")
    Next GF_C_P_idx
    
    
    Str_GroupFunc_all = Trim(Str_GroupFunc_all)
    
    
    Dim col_idx As Integer
    
    Dim Col_Group As Variant
    Dim Col_UnSelected As Variant
    Dim Col_Order As Variant

    
    Col_Group = SplitStrIntoArray(Str_Col_Group, ",")
    Col_UnSelected = SplitStrIntoArray(Str_Col_UnSelected, ",")
    Col_Order = SplitStrIntoArray(Str_Col_Order, ",")
    

    DelTable (Tbl_output_name)
    

    With CurrentDb
        Dim RS_Tbl_input As Recordset
        Set RS_Tbl_input = .OpenRecordset(Tbl_input_name)
        
        With RS_Tbl_input
            Dim SQL_Seg_Select As String
            Dim SQL_Seg_GroupBy As String
            Dim SQL_Seg_OrderBy As String
            
            SQL_Seg_Select = "SELECT "
            SQL_Seg_GroupBy = "GROUP BY "
            SQL_Seg_OrderBy = ""
            
            
            Dim fld_idx As Integer
            Dim fld_name As String
            
            Dim IsColForGroupBy As Boolean
            
            Dim NumOfCol_Group_found As Integer
            NumOfCol_Group_found = 0
            
            Dim Col_GroupBy As Variant
            
            Dim GroupFunc_Col_Pair As Variant
            Dim GroupFunc As String
            
            For fld_idx = 0 To .Fields.count - 1
                fld_name = .Fields(fld_idx).Name
                IsColForGroupBy = False
                
                If NumOfCol_Group_found <= UBound(Col_Group) Then
                    If FindStrInArray(Col_Group, fld_name) > -1 Then
                        SQL_Seg_GroupBy = SQL_Seg_GroupBy & "[" & fld_name & "], "
                        IsColForGroupBy = True
                        NumOfCol_Group_found = NumOfCol_Group_found + 1
                    End If
                End If
                
                                                
                If IsColForGroupBy = True Then
                    SQL_Seg_Select = SQL_Seg_Select & "[" & fld_name & "], "
                    
                ElseIf FindStrInArray(Col_UnSelected, fld_name) < 0 Then
                    GroupFunc = ""
                    
                    For Each GroupFunc_Col_Pair In GroupFunc_Col_Pairs
                        If FindStrInArray(GroupFunc_Col_Pair(1), fld_name) > -1 Then
                            GroupFunc = GroupFunc_Col_Pair(0)
                        End If

                    Next GroupFunc_Col_Pair
                    

                    If GroupFunc = "" And Str_GroupFunc_all <> "" Then
                        For Each GF_all_dbType In GF_all_dbTypes
                            If .Fields(fld_idx).Type = GF_all_dbType Then
                                GroupFunc = Str_GroupFunc_all
                            End If
                        
                        Next GF_all_dbType
                        
                    End If
                    
                    
                    If GroupFunc <> "" Then
                        SQL_Seg_Select = SQL_Seg_Select & GroupFunc & "([" & Tbl_input_name & "].[" & fld_name & "]) AS [" & fld_name & "], "
                    End If
                    
                End If
                
Next_CreateTbl_Group_1:
            Next fld_idx
            
            
            SQL_Seg_Select = Left(SQL_Seg_Select, Len(SQL_Seg_Select) - 2)
            SQL_Seg_GroupBy = Left(SQL_Seg_GroupBy, Len(SQL_Seg_GroupBy) - 2)
            
            .Close
            
        End With 'RS_Tbl_input
        
        
        If UBound(Col_Order) >= 0 Then
            SQL_Seg_OrderBy = "ORDER BY "
            
            For col_idx = 0 To UBound(Col_Order)
                SQL_Seg_OrderBy = SQL_Seg_OrderBy & "[" & Col_Order(col_idx) & "], "
            Next col_idx
            
            SQL_Seg_OrderBy = Left(SQL_Seg_OrderBy, Len(SQL_Seg_OrderBy) - 2)
            
        End If
        
        
        If SQL_Seg_Where <> "" Then
            SQL_Seg_Where = "WHERE " & SQL_Seg_Where
        End If
        
        Dim SQL_cmd As String
        
        SQL_cmd = SQL_Seg_Select & " " & vbCrLf & _
                    "INTO [" & Tbl_output_name & "] " & vbCrLf & _
                    "FROM [" & Tbl_input_name & "] " & vbCrLf & _
                    SQL_Seg_Where & " " & vbCrLf & _
                    SQL_Seg_GroupBy & " " & vbCrLf & _
                    SQL_Seg_OrderBy & " " & vbCrLf & _
                    ";"
        
        'MsgBox SQL_cmd
        RunSQL_CmdWithoutWarning (SQL_cmd)
        
        .Close
        
    End With 'CurrentDb

Exit_CreateTbl_Group:
    CreateTbl_Group = FailedReason
    Exit Function

Err_CreateTbl_Group:
    Call ShowMsgBox(Err.Description)
    Resume Exit_CreateTbl_Group
    
End Function

[VBA] Export access table into one or more worksheets if row count over 65535

https://github.com/walter426/VbaUtilities/

'Export a table to one or more worksheets in case row count over 65535
Public Function ExportTblToSht(Wb_path, Tbl_name As String, sht_name As String) As String
    On Error GoTo Err_ExportTblToSht
   
    Dim FailedReason As String

    If TableExist(Tbl_name) = False Then
        FailedReason = Tbl_name & " does not exist"
        GoTo Exit_ExportTblToSht
    End If

   
    If Len(Dir(Wb_path)) = 0 Then
        Dim oExcel As Excel.Application
        Set oExcel = CreateObject("Excel.Application")
   
        With oExcel
            Dim oWb As Workbook
            Set oWb = .Workbooks.Add
           
           
            With oWb
                .SaveAs Wb_path
                .Close
            End With 'oWb_DailyRpt
           
            .Quit
           
        End With 'oExcel
       
        Set oExcel = Nothing
       
    End If
   
   
    Dim MaxRowPerSht As Long
    Dim RecordCount As Long
       
    MaxRowPerSht = 65534
    RecordCount = Table_RecordCount(Tbl_name)
   
   
    If RecordCount <= 0 Then
        GoTo Exit_ExportTblToSht
   
    ElseIf RecordCount <= MaxRowPerSht Then
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, Tbl_name, Wb_path, True, sht_name
   
    Else
        'handle error msg, "File sharing lock count exceeded. Increase MaxLocksPerFile registry entry"
        DAO.DBEngine.SetOption dbMaxLocksPerFile, 40000
       
       
        Dim Tbl_COPY_name As String
        Tbl_COPY_name = Tbl_name & "_COPY"
       
        DelTable (Tbl_COPY_name)
       
        Dim SQL_cmd As String

        SQL_cmd = "SELECT * " & vbCrLf & _
                    "INTO [" & Tbl_COPY_name & "] " & vbCrLf & _
                    "FROM [" & Tbl_name & "]" & vbCrLf & _
                    ";"
       
        RunSQL_CmdWithoutWarning (SQL_cmd)
       
        SQL_cmd = "ALTER TABLE [" & Tbl_COPY_name & "] " & vbCrLf & _
                    "ADD record_idx COUNTER " & vbCrLf & _
                    ";"
       
        RunSQL_CmdWithoutWarning (SQL_cmd)
       
       
        Dim ShtCount As Integer
        Dim sht_idx As Integer
        Dim Sht_part_name As String
        Dim Tbl_part_name As String
       
        ShtCount = Int(RecordCount / MaxRowPerSht)
       
        For sht_idx = 0 To ShtCount
            Sht_part_name = sht_name
           
            If sht_idx > 0 Then
                Sht_part_name = Sht_part_name & "_" & sht_idx
            End If
               
            Tbl_part_name = Tbl_name & "_" & sht_idx
           
            DelTable (Tbl_part_name)
           
            SQL_cmd = "SELECT * " & vbCrLf & _
                        "INTO [" & Tbl_part_name & "] " & vbCrLf & _
                        "FROM [" & Tbl_COPY_name & "]" & vbCrLf & _
                        "WHERE [record_idx] >= " & sht_idx * MaxRowPerSht + 1 & vbCrLf & _
                        "AND [record_idx] <= " & (sht_idx + 1) * MaxRowPerSht & vbCrLf & _
                        ";"
       
            'MsgBox SQL_cmd
            RunSQL_CmdWithoutWarning (SQL_cmd)
       
       
            SQL_cmd = "ALTER TABLE [" & Tbl_part_name & "] " & vbCrLf & _
                        "DROP COLUMN [record_idx] " & vbCrLf & _
                        ";"
   
            RunSQL_CmdWithoutWarning (SQL_cmd)
           
           
            DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, Tbl_part_name, Wb_path, True, Sht_part_name
           
            DelTable (Tbl_part_name)
           
        Next sht_idx
   
        DelTable (Tbl_COPY_name)
       
    End If

   
Exit_ExportTblToSht:
    ExportTblToSht = FailedReason
    Exit Function

Err_ExportTblToSht:
    FailedReason = Err.Description
    Resume Exit_ExportTblToSht
   
End Function