Match parts of a string - regex

I have 2 strings that each contain 25 characters. E.g.
X = "0000111111110111111111110"
Y = "0000011111000000000000000"
What would be the most efficient method to identify, true or false if every position that has a "1" string Y also has a "1" in string X? In this example it should return True as there are 1s in X that match the positions of all 1s in Y.
I could read each character position and do a comparison for all 25 but was hoping some clever person would know of a more elegant way.

The easier way is to use Convert.ToInt32() to parse the string as a binary literal and perform binary AND:
Public Function MatchAsBinary(ByVal x As String, ByVal y As String) As Boolean
Dim x_int = Convert.ToInt32(x, 2)
Dim y_int = Convert.ToInt32(y, 2)
Return (x_int And y_int) = y_int
End Function
The faster (~10 times in release build) way is to compare the chars directly:
Public Function MatchAsChars(ByVal x As String, ByVal y As String) As Boolean
For i As Integer = 0 To y.Length - 1
If y(i) = "1"c AndAlso x(i) = "0"c Then
Return False
End If
Next
Return True
End Function

If you regard the strings as binary numbers, you can convert them to numbers and then use the bitwise and operator, like this:
Module Module1
Sub Main()
Dim X = "0000111111110111111111110"
Dim Y = "0000011111000000000000000"
Dim Xb = Convert.ToInt64(X, 2)
Dim Yb = Convert.ToInt64(Y, 2)
Console.WriteLine((Xb And Yb) = Yb)
Console.ReadLine()
End Sub
End Module
That will output True and work for strings of up to 64 characters.
Or, following on from your comment, you could use Convert.ToInt32 as that would give enough bits for your data.

Can do something similar #JoshD said above, but use Convert.ToInt32(Y, 2) to convert from a binary string to an integer.
Xint = Convert.ToInt32(X, 2)
Yint = Convert.ToInt32(Y, 2)
return ((Xint And Yint) = Yint)

This includes what others have shown plus a test for each bit one at a time.
Dim s As String = "0000011111000000000000000"
Dim X As String = "0000111111110111111111110"
Dim Y As String = "0000011111000000000000000"
Dim xi As Integer = Convert.ToInt32(X, 2)
Dim yi As Integer = Convert.ToInt32(Y, 2)
'check each bit
For i As Integer = 0 To 24
Dim msk As Integer = 1 << i
If (msk And xi) = msk AndAlso (msk And yi) = msk Then
Debug.WriteLine("Bit {0} on in both", i)
End If
Next
'all bits
Dim rslt As Integer = xi And yi
s = Convert.ToString(rslt, 2).PadLeft(25, "0"c)

Dim intY As Integer = CInt(Y)
Dim res As Boolean = (CInt(X) And intY) = intY
Convert them to integers, get all instances of matching 1's with a bitwise And, then compare to see if Y was changed by that comparison. If the comparison preserved the original Y, the result will be True.

Related

"if then statement in VBA to fill cell with number"

"if then statement in VBA" I'm writing a program that puts a number in a cell in Excell if a variable reaches a certain value. I understand how to declare variables but I don't know how to tell excel to write x if A1 =34. Thanks
Add a listener to your worksheet to capture a Range. You can make the range [A1] if you are only watching a specific column/row, or you can add a range like I have below.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A:A")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
If Target.Value = "34" Then
Cells(Target.Row, 2) = "X"
Else
Cells(Target.Row, 2) = ""
End If
End If
End Sub
Change "x" to if you want variable x and not literal x.
If your goal is to change the value of the cell to "X" (Literal X), and you are not having macros run constantly or with each cell change, you can use the following function (or similar) in each cell in which you have a conditional.
See the Microsoft support on this topic https://support.microsoft.com/en-us/kb/213612
It's not clear what you wish to do, but let's say you want to write the current value of your variable, x, into cell B2... if cell A1 is 34.
In the above case, you would do this:
If [a1] = 34 then [b2] = x
Private Sub CommandButton1_Click()
Dim lr As Long
lr = Worksheets("New").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("New").Range("T2").Formula = "=LEFT(B2,2)"
Worksheets("New").Range("T2").AutoFill Destination:=Worksheets("New").Range("T2:T" & lr)
Worksheets("New").Range("U2").Formula = "=(T2&0&0)"
Worksheets("New").Range("U2").AutoFill Destination:=Worksheets("New").Range("U2:U" & lr)
Worksheets("New").Range("V2").Formula = "=IF(AND(a2=A1,U2=U1),"",A2")" (HOW TO AUTO FILL THIS FORMULA IN A CELL)
Worksheets("New").Range("V2").AutoFill Destination:=Worksheets("New").Range("V2:V" & lr)
End Sub

VBA Excel DLL Argument Issue - 6th Arg

so I've got this VBA code that calls DLL code. The DLL code works fine, the VBA code works fine UNTIL I go to call the DLL function from the VBA. For some reason it's not passing the 6th argument correctly. I tested by adding a 7th argument and passing the same value in the 6th and 7th arguments - the 7th passes fine, the 6th passes the same large (incorrect) value. I have no clue what is going on.
VBA:
Option Explicit
' Declare the LMM Function that's in the DLL
Declare PtrSafe Function GenCudaLMMPaths Lib "C:\Path to DLL\LMMExcel.dll" Alias "GenerateCUDALMMPaths" (xTimes#, xRates#, xVols#, xRData#, ByRef ArrLen As Long, ByRef NPaths As Long) As Long
' Generate LMM Paths on Click
Sub LMM_Click()
Dim Times#(), Rates#(), Vols#()
Dim x As Long
Dim y As Long
Dim rTimes As Range
Dim rRates As Range
Dim rVols As Range
Dim cell As Range
Dim sz As Long
sz = 15
' Resize
ReDim Times(sz), Rates(sz), Vols(sz)
' Fill in Data
Set rTimes = Sheets("Market").Range("C2:Q2")
x = 1
For Each cell In rTimes
Times(x) = cell.Value
x = x + 1
Next
Set rRates = Sheets("Market").Range("C5:Q5")
x = 1
For Each cell In rRates
Rates(x) = cell.Value
x = x + 1
Next
Set rVols = Sheets("Market").Range("C4:Q4")
x = 1
For Each cell In rVols
Vols(x) = cell.Value / 10000
x = x + 1
Next
'Call the Function
Dim np As Long
np = Sheets("LMM").Range("C2").Value
Dim useCuda As Boolean
If Sheets("LMM").Range("C3").Value = "GPU" Then
useCuda = True
Else
useCuda = False
End If
Dim rData#()
Dim rValue
ReDim rData(np * sz * (sz + 3))
rValue = GenCudaLMMPaths(Times(1), Rates(1), Vols(1), rData(1), sz, np)
If rValue = -1 Then
'No CUDA Card
MsgBox ("Your system doesn't have a CUDA Enabled GPU")
ElseIf rValue = 1 Then
'Error Occurred
MsgBox ("An error occurred while trying to generate LMM paths")
ElseIf rValue = 0 Then
'Success
' Need to reformat return data
Dim fmtData()
ReDim fmtData(np * sz, sz)
Dim i, j, k
For i = 0 To np - 1
For j = 0 To np - 1
For k = 0 To np - 1
fmtData(((i * sz) + j) + 1, k + 1) = rData(((i * sz * sz) + (j * sz) + k) + 1)
Next k
Next j
Next i
'Fill in data
Sheets("LMM").Range("A8:K" & (np * sz)) = fmtData
Else
'Too many requested paths for this CUDA card
MsgBox ("In order to prevent GPU Lock-up, you cannot request more than " & rValue & " paths.")
Sheets("LMM").Range("C2").Value = rValue
End If
End Sub
DLL Function Declaration:
int __stdcall GenerateCUDALMMPaths(double* arrTimes, double* arrRates, double* arrVols, double* retData, int& ArrLength, int& NPaths);
DEF File:
LIBRARY "CUDAFinance"
EXPORTS
CheckExcelArray = CheckExcelArray
GenerateLMMPaths = GenerateLMMPaths
GenerateCUDALMMPaths = GenerateCUDALMMPaths
Anyone have any idea here? I'm completely lost.
I just run into the same problem and got it solved as follows.
Since you already have a long variable in the six arguments function, import the NPaths together with Arrlen as an array without adding a 7th argument:
1) In VBA:
Declare a two elements array:
Dim NArrLenNPaths(1) as long
Then, assign values:
NArrLenNPaths(0) contains ArrLen and NArrLenNPaths(1) the NPaths value.
Keep the function delcaration in VBA but when calling it put NArrLenNPaths(0) as 6th argument. Do not put a 7th argument. The C++ will retreive both values as follows.
2) In C++ use a pointer instead:
Change the 6th argument to
int* NArrLenNPaths
then retreive the values by
int NArrLen = NArrLenNPaths[0];
int NPaths = NArrLenNPaths[1];

How to emulate .net Int64 in VB6?

How can store an Int64 number in VB6, to work with Win32 functions?
Is there a way to define a type like Int64 in .net? And simply evaluate the number.
I think many of VB6 programmers need something like this,
Because some of the Win32 API's use _int64 as their parameters.
I wrote a function to cast a currency into an API compatible structure.
Put these codes in a module file.
Private Declare Sub CopyMemory lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Const SIZEOF_INT64 As Long = 8
Public Type Int64 'LowPart must be the first one in LittleEndian systems
'required part
LowPart As Long
HighPart As Long
'optional part
SignBit As Byte 'define this as long if you want to get minimum CPU access time.
End Type
'with the SignBit you can emulate both Int64 and UInt64 without changing the real sign bit in HighPart.
'but if you want to change it you can access it like this mySign = (myVar.HighPart And &H80000000)
'or turn on the sign bit using myVar.HighPart = (myVar.HighPart Or &H80000000)
Public Function CInt64(ByVal vCur As Currency) As Int64
vCur = (CCur(vCur) * 0.0001#)
Call CopyMemory(CInt64, vCur, SIZEOF_INT64)
End Function
Now you can simply use CInt64 to create an Int64 number.
ex:
myRetVal = Win32APIFunctionWithOneInt64Param(CInt64(10000000))
'----OR
Dim myNum As Int64
myNum = CInt64(10000000)
And for more operations:
Public Sub Op_Ev(Dest As Int64, Src As Int64) 'for setting the value.
Call CopyMemory(Dest, Src, SIZEOF_INT64)
End Sub
Public Function Op_Eq(V1 As Int64, V2 As Int64) As Boolean 'for equal comparison.
Op_Eq = (V1.LowPart = V2.LowPart) : If Not Op_Eq Then Exit Function
Op_Eq = (V1.HighPart = V2.HighPart)
End Function
Public Function Op_Gr(V1 As Int64, V2 As Int64, Optional ByVal IsUnsignedComparison As Boolean = False) As Boolean 'for grater comparison.
If IsUnsignedComparison Then
Dim H1 As Long, H2 As Long 'don't change the location of these definitions to optimize the function to prevent to execute two or more {SUB ESP, 4}
H1 = (V1.HighPart And &H7FFFFFFF) : H2 = (V2.HighPart And &H7FFFFFFF)
Op_Gr = (H1 > H2) : If (H1 <> H2) Then Exit Function
Dim HBS1 As Long, HBS2 As Long 'don't change the type of these two vars to byte to keep alignment for local variables.
HBS1 = ((V1.HighPart And &H80000000) / &H80000000) 'export the sign bit and shift it to the right.
HBS2 = ((V2.HighPart And &H80000000) / &H80000000) 'export the sign bit and shift it to the right.
Op_Gr = (HBS1 > HBS2) : If (HBS1 <> HBS2) Then Exit Function
Else
Op_Gr = (V1.HighPart > V2.HighPart) : If (V1.HighPart <> V2.HighPart) Then Exit Function
End If
Op_Gr = (V1.LowPart > V2.LowPart)
End Function
Public Function Op_Ls(V1 As Int64, V2 As Int64, Optional ByVal IsUnsignedComparison As Boolean = False) As Boolean 'for less comparison.
If IsUnsignedComparison Then
Dim H1 As Long, H2 As Long 'don't change the location of these definitions to optimize the function to prevent to execute two or more {SUB ESP, 4}
H1 = (V1.HighPart And &H7FFFFFFF) : H2 = (V2.HighPart And &H7FFFFFFF)
Op_Ls = (H1 < H2) : If (H1 <> H2) Then Exit Function
Dim HBS1 As Long, HBS2 As Long 'don't change the type of these two vars to byte to keep alignment for local variables.
HBS1 = ((V1.HighPart And &H80000000) / &H80000000) 'export the sign bit and shift it to the right.
HBS2 = ((V2.HighPart And &H80000000) / &H80000000) 'export the sign bit and shift it to the right.
Op_Ls = (HBS1 < HBS2) : If (HBS1 <> HBS2) Then Exit Function
Else
Op_Ls = (V1.HighPart < V2.HighPart) : If (V1.HighPart <> V2.HighPart) Then Exit Function
End If
Op_Ls = (V1.LowPart < V2.LowPart)
End Function
Public Function Op_Cmp(V1 As Int64, V2 As Int64, Optional ByVal IsUnsignedComparison As Boolean = False) As Long 'for comparison.
If Op_Gr(V1, V2, IsUnsignedComparison) Then
Op_Cmp = 1
ElseIf Op_Ls(V1, V2, IsUnsignedComparison) Then
Op_Cmp = -1
Else
Op_Cmp = 0
End If
End Function

Find index of string in large file performance

I have a "container" containing data. The size is +- 100MB.
In the container there a several "dataids's" that mark the begin of something.
Now I need to get an index for an given dataid. (dataid for example: '4CFE7197-0029-006B-1AD4-000000000012')
I have tried several approaches. But at this moment "ReadAllBytes" is the most performant.
ReadAll -> average of 0.6 seconds
Using oReader As New BinaryReader(File.Open(sContainerPath, FileMode.Open, FileAccess.Read))
Dim iLength As Integer = CInt(oReader.BaseStream.Length)
Dim oValue As Byte() = Nothing
oValue = oReader.ReadBytes(iLength)
Dim enc As New System.Text.ASCIIEncoding
Dim sFileContent As String = enc.GetString(oValue)
Dim r As Regex = New Regex(sDataId)
Dim lPosArcID As Integer = r.Match(sFileContent).Index
If lPosArcID > 0 Then
Return lPosArcID
End If
End Using
ReadByteByByte -> average of 1.4 seconds
Using oReader As BinaryReader = New BinaryReader(File.Open(sContainerPath, FileMode.Open, FileAccess.Read))
Dim valueSearch As StringSearch = New StringSearch(sDataId)
Dim readByte As Byte
While (InlineAssignHelper(readByte, oReader.ReadByte()) >= 0)
index += 1
If valueSearch.Found(readByte) Then
Return index - iDataIdLength
End If
End While
End Using
Public Class StringSearch
Private ReadOnly oValue() As Byte
Private iValueIndex As Integer = -1
Public Sub New(value As String)
Dim oEncoding As New System.Text.ASCIIEncoding
Me.oValue = oEncoding.GetBytes(value)
End Sub
Public Function Found(oNextByte As Byte) As Boolean
If oValue(iValueIndex + 1) = oNextByte Then
iValueIndex += 1
If iValueIndex + 1 = oValue.Count Then Return True
Else
iValueIndex = -1
End If
Return False
End Function
End Class
Public Function InlineAssignHelper(Of T)(ByRef target As T, ByVal value As T) As T
target = value
Return value
End Function
I find it hard to believe that there is no faster way.
0.6 seconds for a 100MB file is not an acceptable time.
An other approach that I tried, is to split in chuncks of X bytes (100, 1000, ..). But was alot slower.
Any help on an approach I can try?

Getting child properties in WPF Using VisualTreeHelper not returning values

Once I use visualTreeHelper.getchild to find a child object, how would I get the name of that object, or even other properties of the object like width or height?
i.e.
This doesnt work:
For i As Integer = 0 To VisualTreeHelper.GetChildrenCount(Can1) - 1
Dim ChildVisual As Visual = CType(VisualTreeHelper.GetChild(Can1, i), Visual)
Dim ChildName As DependencyProperty = childVisual.GetValue(Name)
It says value of type "Name" cannot be converted to a system.windows.dependencyProperty
Nor does this work (But at least it compiles):
For i As Integer = 0 To VisualTreeHelper.GetChildrenCount(Can1) - 1
Dim childVisual As Visual = CType(VisualTreeHelper.GetChild(Can1, i), Visual)
Dim GT1 As GeneralTransform = childVisual.TransformToAncestor(Can1)
Dim currentpoint As Point = GT1.Transform(New Point(0, 0))
x = currentpoint.X
y = currentpoint.Y
If I hover over childvisual, I can look at it's properties and see that name has been set to a name of an image I have on the canvas(Can1).
But, X and Y are always 0.
I found this finally on the net, and it seems to work great.
Dim childVisual As Visual = CType(VisualTreeHelper.GetChild(Can1, i), Visual)
Dim ChildName As String = ChildVisual.GetValue(Control.NameProperty)