Fast Native Memory Manipulation in VBA

I’ve been quite annoyed lately by the fact that the CopyMemory API (RtlMoveMemory on Windows and MemMove on Mac) is running much slower than it used to, on certain computers. For example on one of my machines (x64 Windows and x32 Office) the CopyMemory API is running about 600 times slower than a month ago. I did do a Windows Update lately and maybe that is why. In this SO question is seems that Windows Defender is the cause of slowness. Regardless of why the API is much slower, it is unusable if the operations involving the API need to run many times (e.g. millions of times).

Even without the issue mentioned above, CopyMemory API is slower than other alternatives. Since I did not want to use references to msvbvm60.dll which is not available on most of my machines, I decided to create something similar with the GetMemX and PutMemX methods available in the mentioned dll. So, I created a couple of properties (Get/Let) called MemByte, MemInt, MemLong and MemLongPtr using the same ByRef technique that I’ve used in the WeakReference repository. In short, I am using 2 Variants that have the VT_BYREF flag set inside the 2 Bytes holding the VarType. These 2 Variants allow remote read/write of memory.

Code

The full module with more explanations and also demos are available on GitHub at VBA-MemoryTools.

LibMemory standard module:

Option Explicit
Option Private Module

'Used for raising errors
Private Const MODULE_NAME As String = "LibMemory"

#If Mac Then
#If VBA7 Then
Public Declare PtrSafe Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, source As Any, ByVal Length As LongPtr) As LongPtr
#Else
Public Declare Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, source As Any, ByVal Length As Long) As Long
#End If
#Else 'Windows
'https://msdn.microsoft.com/en-us/library/mt723419(v=vs.85).aspx
#If VBA7 Then
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, source As Any, ByVal Length As LongPtr)
#Else
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, source As Any, ByVal Length As Long)
#End If
#End If

#If VBA7 Then
Public Declare PtrSafe Function VarPtrArray Lib "VBE7.dll" Alias "VarPtr" (ByRef ptr() As Any) As LongPtr
#Else
Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef ptr() As Any) As Long
#End If

'The size in bytes of a memory address
#If Win64 Then
Public Const PTR_SIZE As Long = 8
#Else
Public Const PTR_SIZE As Long = 4
#End If

#If Win64 Then
#If Mac Then
Public Const vbLongLong As Long = 20 'Apparently missing for x64 on Mac
#End If
Public Const vbLongPtr As Long = vbLongLong
#Else
Public Const vbLongPtr As Long = vbLong
#End If

Private Type REMOTE_MEMORY
memValue As Variant
remoteVT As Variant
isInitialized As Boolean 'In case state is lost
End Type

'https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-oaut/3fe7db9f-5803-4dc4-9d14-5425d3f5461f
'https://docs.microsoft.com/en-us/windows/win32/api/oaidl/ns-oaidl-variant?redirectedfrom=MSDN
'Flag used to simulate ByRef Variants
Public Const VT_BYREF As Long = &H4000

Private m_remoteMemory As REMOTE_MEMORY

'*******************************************************************************
'*******************************************************************************
#If VBA7 Then
Public Property Get MemByte(ByVal memAddress As LongPtr) As Byte
#Else
Public Property Get MemByte(ByVal memAddress As Long) As Byte
#End If
MemByte = m_remoteMemory.memValue
End Property
#If VBA7 Then
Public Property Let MemByte(ByVal memAddress As LongPtr, ByVal newValue As Byte)
#Else
Public Property Let MemByte(ByVal memAddress As Long, ByVal newValue As Byte)
#End If
LetByRef(m_remoteMemory.memValue) = newValue
End Property

'*******************************************************************************
'Read/Write 2 Bytes (Integer) from/to memory
'*******************************************************************************
#If VBA7 Then
Public Property Get MemInt(ByVal memAddress As LongPtr) As Integer
#Else
Public Property Get MemInt(ByVal memAddress As Long) As Integer
#End If
MemInt = m_remoteMemory.memValue
End Property

#If VBA7 Then
Public Property Let MemInt(ByVal memAddress As LongPtr, ByVal newValue As Integer)
#Else
Public Property Let MemInt(ByVal memAddress As Long, ByVal newValue As Integer)
#End If
LetByRef(m_remoteMemory.memValue) = newValue
End Property

'*******************************************************************************
'Read/Write 4 Bytes (Long) from/to memory
'*******************************************************************************
#If VBA7 Then
Public Property Get MemLong(ByVal memAddress As LongPtr) As Long
#Else
Public Property Get MemLong(ByVal memAddress As Long) As Long
#End If
MemLong = m_remoteMemory.memValue
End Property
#If VBA7 Then
Public Property Let MemLong(ByVal memAddress As LongPtr, ByVal newValue As Long)
#Else
Public Property Let MemLong(ByVal memAddress As Long, ByVal newValue As Long)
#End If
LetByRef(m_remoteMemory.memValue) = newValue
End Property

'*******************************************************************************
'Read/Write 8 Bytes (LongLong) from/to memory
'*******************************************************************************
#If VBA7 Then
Public Property Get MemLongPtr(ByVal memAddress As LongPtr) As LongPtr
#Else
Public Property Get MemLongPtr(ByVal memAddress As Long) As Long
#End If
MemLongPtr = m_remoteMemory.memValue
End Property
#If VBA7 Then
Public Property Let MemLongPtr(ByVal memAddress As LongPtr, ByVal newValue As LongPtr)
#Else
Public Property Let MemLongPtr(ByVal memAddress As Long, ByVal newValue As Long)
#End If
#If Win64 Then
'Cannot set Variant/LongLong ByRef so we use a Currency instead
Const currDivider As Currency = 10000
LetByRef(m_remoteMemory.memValue) = CCur(newValue / currDivider)
#Else
#End If
End Property

'*******************************************************************************
'Redirects the rm.memValue Variant to the new memory address so that the value
'*******************************************************************************
Private Sub DeRefMem(ByRef rm As REMOTE_MEMORY, ByRef memAddress As LongPtr, ByRef vt As VbVarType)
With rm
If Not .isInitialized Then
'Link .remoteVt to the first 2 bytes of the .memValue Variant
.remoteVT = VarPtr(.memValue)
CopyMemory .remoteVT, vbInteger + VT_BYREF, 2
'
.isInitialized = True
End If
LetByRef(.remoteVT) = vt + VT_BYREF 'Faster than: CopyMemory .memValue, vt + VT_BYREF, 2
End With
End Sub

'*******************************************************************************
'Utility for updating remote values that have the VT_BYREF flag set
'*******************************************************************************
Private Property Let LetByRef(ByRef v As Variant, ByRef newValue As Variant)
v = newValue
End Property

#If VBA7 Then
Public Function UnsignedAddition(ByVal val1 As LongPtr, ByVal val2 As LongPtr) As LongPtr
#Else
Public Function UnsignedAddition(ByVal val1 As Long, ByVal val2 As Long) As Long
#End If
'The minimum negative integer value of a Long Integer in VBA
#If Win64 Then
Const minNegative As LongLong = &H8000000000000000^ '-9,223,372,036,854,775,808 (dec)
#Else
Const minNegative As Long = &H80000000 '-2,147,483,648 (dec)
#End If
'
If val1 > 0 Then
If val2 > 0 Then
'Overflow could occur
If (val1 + minNegative + val2) < 0 Then
'The sum will not overflow
Else
'Example for Long data type (x32):
'   &H7FFFFFFD + &H0000000C =  &H80000009
'   2147483645 +         12 = -2147483639
UnsignedAddition = val1 + minNegative + val2 + minNegative
End If
Else 'Val2 <= 0
'Sum cannot overflow
End If
Else 'Val1 <= 0
If val2 > 0 Then
'Sum cannot overflow
Else 'Val2 <= 0
'Overflow could occur
On Error GoTo ErrorHandler
End If
End If
Exit Function
ErrorHandler:
Err.Raise 6, MODULE_NAME & ".UnsignedAddition", "Overflow"
End Function


Demo

For demos that are testing speed go to the Demo module in the above mentioned repository.

Sub DemoMem()
#If VBA7 Then
Dim ptr As LongPtr
#Else
Dim ptr As Long
#End If
Dim i As Long
Dim arr() As Variant
ptr = ObjPtr(Application)
'
ReDim arr(0 To PTR_SIZE - 1)
For i = LBound(arr) To UBound(arr)
Next i
Debug.Print Join(arr, " ")
'
ReDim arr(0 To PTR_SIZE / 2 - 1)
For i = LBound(arr) To UBound(arr)
arr(i) = MemInt(UnsignedAddition(ptr, i * 2))
Next i
Debug.Print Join(arr, " ")
'
ReDim arr(0 To PTR_SIZE / 4 - 1)
For i = LBound(arr) To UBound(arr)
arr(i) = MemLong(UnsignedAddition(ptr, i * 4))
Next i
Debug.Print Join(arr, " ")
'
Debug.Print MemLongPtr(ptr)
'
'Write Memory using MemByte
ptr = 0
MemByte(VarPtr(ptr)) = 24
Debug.Assert ptr = 24
Debug.Assert ptr = 1572888
'
'Write Memory using MemInt
ptr = 0
Debug.Assert ptr = 19660800
'
'Write Memory using MemLong
ptr = 0
MemLong(VarPtr(ptr)) = 77777
Debug.Assert ptr = 77777
'
'Write Memory using MemLongPtr
MemLongPtr(VarPtr(ptr)) = ObjPtr(Application)
Debug.Assert ptr = ObjPtr(Application)
End Sub


Decisions

For those that are not aware, a LongLong integer cannot be modified ByRef if it is passed inside a Variant. Example:

#If Win64 Then
Private Sub DemoByRefLongLong()
Dim ll As LongLong
EditByRefLLVar ll, 1^
End Sub
Private Sub EditByRefLLVar(ByRef ll As Variant, ByRef newValue As LongLong)
ll = newValue 'Error 458 - Variable uses an Automation type not supported...
End Sub
#End If


Since I couldn’t use the same approach I’ve used for Byte, Integer and Long I’ve finally decided to go for the Currency approach because it was the cleanest and fastest. A Currency variable is stored using 8 Bytes in an integer format, scaled by 10,000 resulting in a fixed point number. So, it was quite easy to use currency instead of LongLong (see the MemLongPtr Let property).

Another approach is to use a Double but looks absolutely horrendous (and is slower) and needs a second REMOTE_MEMORY variable:

#If VBA7 Then
Public Property Let MemLongPtr(ByVal memAddress As LongPtr, ByVal newValue As LongPtr)
#Else
Public Property Let MemLongPtr(ByVal memAddress As Long, ByVal newValue As Long)
#End If
#If Win64 Then
Static rm As REMOTE_MEMORY
With rm
If Not .isInitialized Then
'Link .remoteVt to the first 2 bytes of the .memValue Variant
.remoteVT = VarPtr(.memValue)
CopyMemory .remoteVT, vbInteger + VT_BYREF, 2
'
.isInitialized = True
End If
.memValue = newValue
LetByRef(.remoteVT) = vbDouble
End With
LetByRef(m_remoteMemory.memValue) = rm.memValue
#Else
#End If
End Property


Another approach is to write two Longs:

#If VBA7 Then
Public Property Let MemLongPtr(ByVal memAddress As LongPtr, ByVal newValue As LongPtr)
#Else
Public Property Let MemLongPtr(ByVal memAddress As Long, ByVal newValue As Long)
#End If
#If Win64 Then
#Else
#End If
End Property

#If Win64 Then
Private Function HiLong(ByVal ll As LongLong) As Long
HiLong = VBA.Int(ll / &H100000000^)
End Function
Private Function LoLong(ByVal ll As LongLong) As Long
If ll And &H80000000^ Then
LoLong = CLng(ll And &H7FFFFFFF^) Or &H80000000
Else
LoLong = CLng(ll And &H7FFFFFFF^)
End If
End Function
#End If


This approach looks dangerous because it might change half of a pointer first and by the time the second half is changed, some other code uses that pointer to do something that will likely result in a crash or data corruption.

Another decision was to leave the DeRefMem method as a Sub. Consider the current code (excluding the VBA7 declartations):

Public Property Get MemByte(ByVal memAddress As LongPtr) As Byte
MemByte = m_remoteMemory.memValue
End Property
Public Property Let MemByte(ByVal memAddress As LongPtr, ByVal newValue As Byte)
LetByRef(m_remoteMemory.memValue) = newValue
End Property

Private Sub DeRefMem(ByRef rm As REMOTE_MEMORY, ByRef memAddress As LongPtr, ByRef vt As VbVarType)
With rm
If Not .isInitialized Then
.isInitialized = True
'Link .remoteVt to the first 2 bytes of the .memValue Variant
.remoteVT = VarPtr(.memValue)
CopyMemory .remoteVT, vbInteger + VT_BYREF, 2
End If
LetByRef(.remoteVT) = vt + VT_BYREF
End With
End Sub


and now the Function equivalent:

Public Property Get MemByte(ByVal memAddress As LongPtr) As Byte
End Property
Public Property Let MemByte(ByVal memAddress As LongPtr, ByVal newValue As Byte)
End Property

Private Function DeRefMem(ByRef memAddress As LongPtr, ByRef vt As VbVarType) As REMOTE_MEMORY
Static rm As REMOTE_MEMORY
With rm
If Not .isInitialized Then
.isInitialized = True
'Link .remoteVt to the first 2 bytes of the .memValue Variant
.remoteVT = VarPtr(.memValue)
CopyMemory .remoteVT, vbInteger + VT_BYREF, 2
End If
LetByRef(.remoteVT) = vt + VT_BYREF
End With
DeRefMem = rm
End Function


The Function approach looks definitely more readable. The problem is that it is 2-3 times slower than the Sub equivalent. Since this code will act as a library, I went with the faster approach.

I would be very grateful for suggestions that could improve the code.
Have I missed anything obvious? Are there any other useful methods that should be part of such a ‘Memory’ library (e.g. like I’ve added VarPtrArray and UnsignedAddition)?

I should also mention that although I wrote the necessary conditional compilations to make the code work for VB6, I cannot test it on VB6 because I don’t have VB6 available.

algebraic manipulation – How to obtain the rationalizing factor of an expression with radicals, which code produces what you want?

Thanks for contributing an answer to Mathematica Stack Exchange!

But avoid

• Making statements based on opinion; back them up with references or personal experience.

Use MathJax to format equations. MathJax reference.

list manipulation – How to apply plot legends to this listplot

I have this listplot , and I would like to add a legend to it. Unfortunately, the plotlegends-> automatic does not work. I was wondering if there are any other ways to add a legend to this listplot.

points = Join[
RandomVariate[
MultinormalDistribution[{-0.5, 0.25}, 0.07 IdentityMatrix[2]],
1000], RandomVariate[
MultinormalDistribution[{0.6, -0.1}, 0.03 IdentityMatrix[2]],
1000], RandomReal[{-1.5, 1.5}, {1000, 2}]]; skd =
SmoothKernelDistribution[points] ; ListPlot[points,
ColorFunction -> Function[{x, y}, Hue[PDF[skd, {x, y}]]],
ColorFunctionScaling -> False, AspectRatio -> 1]


list manipulation – Composition of Maps

I want to create a composition of several lists. For example:

list1 = {1, 2};
list2 = {3, 4};
list3 = {5, 6};
Table( list1((i)) list2((j)) list3((k)), {i, 1, 2}, {j, 1, 2}, {k, 1, 2})
{{{15, 18}, {20, 24}}, {{30, 36}, {40, 48}}}


However, I want to make it using Map function. I understand how to create a product of two lists:

Map(list1 # &, list2)
{{3, 6}, {4, 8}}


But I need to make something like

Map(Map((list1*#1*#2) &, list2) &, list3)


Which doesn’t work properly.

list manipulation – Use Mathematica to split a sequence according to other two sequences

I want to use Mathematica to solve the following problem:

For example I have a sequence 101. I want to compare it with $$1101$$ and $$0101$$. The comparison has the following procedure:

1. Check the first term of $$101$$ is $$1$$ or $$0$$. If it is $$1$$, compare $$101$$ to $$1101$$, term by term; If it is $$0$$, compare $$101$$ to $$0101$$. Stop the process before the first term they are different, or all the terms of $$101$$ have been compared without stopping the process, and report all the terms that have been compared.

In our case, the first term of $$101$$ is $$1$$, so we compare it with $$1101$$. Then, $$101$$ and $$1101$$ only has one term in common, the first term $$1$$. So the program should report $$1$$, and go to next step.

1. Recording the remaining sequence of $$101$$.

In our case, as only $$1$$ is reported, the remaining sequence is $$01$$.

1. Restart the process. Check the first term of $$01$$ is $$0$$ or $$1$$. If it $$0$$, compare $$01$$ with $$0101$$, if it is $$1$$, compare $$01$$ with $$1101$$. Stop the process before the first term they are different, or the sequence of $$01$$ has been run out. Report all the timers that have been compared.

*In our case, the first term of $$01$$ is $$0$$, so we compare $$01$$ with $$0101$$. Then the first two terms agree, and then $$01$$ ran out. The program should report $$01$$, and then stop.

1. Repeating the process again and again until there is no remaining sequence.

I tried to use the commend “If” to write this but it did not work, since I did not know how to let Mathematica to “remember” what has been compared.

Then, I tried to use commend “Order” and “Sort”, but it seems that I need to program a comparison function.

Is there anyway for me to achieve this using Mathematica? Thank you!

list manipulation – How to compute k’th tensor power of matrix

Is there a 1-liner to compute $$M^{otimes k}$$ where $$M$$ is some matrix and $$otimes$$ is the Kronecker product? The documentation says I can write

Z = {{1,0},{0,-1}};
KroneckerProduct(Z,Z)


What I’d like is some way (eg a function KroneckerPower(M_,k_)) that does this for $$k$$ copies of $$M$$.

algebraic manipulation – Resolve Error or Mathematica’s Bug?

The following code,

    Resolve(Exists({n1, n2, n3}, {n1, n2, n3} (Element)
NonNegativeIntegers,
1/2 (1 + n1 + n2 - n3) (Element) NonPositiveIntegers))


gives output True but if I run LaunchKernels() and then rerun the exact same code above then the output is

Exists({n1, n2, n3}, Element(n1 | n2 | n3, Integers) &&
n1 >= 0 && n2 >= 0 && n3 >= 0,
Element((1 + n1 + n2 - n3)/2, Integers) &&
(1 + n1 + n2 - n3)/2 <= 0)



So is this a bug of Mathematica?

Moreover, I also tried to evaluate a similar code.

Resolve(Exists({n1, n2, n3}, {n1, n2, n3} (Element)
NonNegativeIntegers,
1/2 (1 + n1 - n2 + n3) (Element) NonPositiveIntegers))


where n2 and n3 is swapped. But then the output is True both before and after LaunchKernels().

So what is the precise reason for this abnormal behavior? Any idea how to solve it?

Note: If we use Reduce instead of Resolve, it will not help.

c++ – String/text manipulation utility class

I’d like to get some expert’s view on this first piece of code especially in the area of

• performance – (e.g. avoidable copies)
• good practice (e.g. static members?)

The final goal is the provide some abstractions for text manipulation like cleansing, stop-word removal and tokenization. The code base should grow substantially in the future so a lot more string manipulation methods should be supported. I understand that this should be bundled in a library in the end, however, I’d like to get feedback on the general code style first.

#include <fstream>
#include <iostream>
#include <regex>
#include <sstream>
#include <string>
#include <vector>

class TextManipulator {
public:
static std::string replace(std::string &string, const std::string pattern,
const std::string toreplace) {
return std::regex_replace(string, std::regex(pattern), toreplace);
}

static std::string toLowerCase(std::string &string) {
std::locale loc;
std::string res;
for (auto elem : string) {
res += std::tolower(elem, loc);
}
return res;
}

static std::vector<std::string> split(const std::string &text,
char seperator) {
std::vector<std::string> tokens;
std::size_t start = 0, end = 0;
while ((end = text.find(seperator, start)) != std::string::npos) {
std::string extr = text.substr(start, end - start);
if (!extr.empty()) {
tokens.push_back(extr);
}
start = end + 1;
}
tokens.push_back(text.substr(start));
}
};

int main() {
std::ifstream input(
"/example_docs/Pride_and_Prejudice.txt");
std::stringstream buffer;
buffer << input.rdbuf();
std::string text = buffer.str();

text = TextManipulator::replace(text, "rn", " ");
text = TextManipulator::replace(text, ",", "");
text = TextManipulator::replace(text, ":", "");
text = TextManipulator::replace(text, ".", "");
text = TextManipulator::toLowerCase(text);
std::vector<std::string> tokens = TextManipulator::split(text, ' ');

return 0;
}


list manipulation – Is this the weakness or the strength of Mathematica?

I really love the flexibility of Mathematica: there are several ways to perform one task. However, to get the performance of the intense numeric calculation, it can cause some confuses. I wonder is it the real strength or the weakness of the language.

Example: Take a list of the first element in a matrix.

test1 = Transpose({Range(10^8), Range(10^8)});


The input list is Packed Array.

DeveloperPackedArrayQ(test1)
True


For this simple task, there are many ways to do that. Now guess the performance of these commands:

test1 /. {a_, _} -> a; // Timing
First /@ test1; // Timing
test1((All, 1)); // Timing
Transpose(test1)((1)); // Timing
First(Transpose(test1)); // Timing
Take(Transpose(test1), 1); // Timing


I think that, “Oh, the third one which uses only one function Part. This one should be the fastest”. The rule of thumb, is:

• Use lesser function will improve the speed
• Treat the data as the whole
• Use built-in function
• Use packed array, etc
• Avoid using Patterns for numerical calculation

So test1((All, 1)) should be the fastest. But no, I’m wrong.

Timing results:

The slowest solution is:

test1 /. {a_, _} -> a; // Timing


Don’t run this, because Mathematica will be stuck. (I need to Abort the Evaluation). It’s obvious because Pattern searching and replacement are expensive. Luckily I didn’t often use this type of programming.

The next slow solution is:

First /@ test1; // Timing
{2.90625, Null}

Surprisingly, Part is the next slow solution. I wonder why? This is the only case that uses one function Part.

test1((All, 1)); // Timing
{1.21875, Null}


And the combinations of 2 functions approaches are faster. Transpose and then Part, First and Transpose, Take and Transpose.

Transpose(test1)((1)); // Timing
First(Transpose(test1)); // Timing
Take(Transpose(test1), 1); // Timing

{0.765625, Null}

{0.734375, Null}

{0.609375, Null}
`

The main question here is, there are too many approaches to perform the same operation. And normally, I didn’t know which approach is the most optimal way in terms of efficiency.

list manipulation – Flatten sublist

I am not sure how to flatten the sublist {a,c,e} without flattening the whole list. Any help on these parts would be great.

Given myList defined as {a, {a, b}, {c, {d, {a, c, e}}}}:

A) Flatten out the sublist {a, c, e} in myList;

B) Define function f(x) to be Log(a,x), then apply this function f to all elements a in myList;

C) Flatten the list that is created in B) to level 1 (i.e. flatten the elements that are on level 1);

D) Use the proper command to remove duplicated level 1 elements in the list that is created in C).