Translate

2013年8月29日 星期四

[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

2013年8月26日 星期一

[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

2013年8月25日 星期日

[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.

2013年8月24日 星期六

[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.

2013年8月21日 星期三

[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

2013年8月20日 星期二

[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...

2013年8月7日 星期三

[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