How To Get Default Directories Of Drives In QB64 - basic

I have been using the following code to get the default directories of all drives, however I don't want to use _CWD$
is there a more efficient way to do this?
REM get default directory of drives.
ON ERROR GOTO ErrSub
FOR D = 1 TO 26
D$ = CHR$(D + 64) + ":"
DataError = 0
CHDIR D$
IF DataError = 0 THEN
PRINT _CWD$
END IF
NEXT
END
ErrSub:
DataError = ERR
RESUME NEXT

For the _CWD$ replacement, you can do this:
' Need to use DECLARE LIBRARY for the C function getcwd(string, stringSize).
DECLARE LIBRARY ""
FUNCTION getcwd$ (buffer$, BYVAL buflen)
END DECLARE
' Wrapper function for making usage of getcwd$ more BASIC-like.
DECLARE FUNCTION qb64cwd$ ()
' Print the current working directory.
PRINT qb64cwd$
FUNCTION qb64cwd$ ()
' 32768 characters should be more than large enough on any OS.
REDIM s AS STRING * 32768
qb64cwd$ = getcwd$(s, 32768)
END FUNCTION
While you don't really need to have a wrapper function, the C function requires you to pass a string with a sufficient amount of writable memory. That is, getcwd doesn't allocate memory. It expects you to pass a sufficient amount of memory, and QB64's dynamically sized STRING type won't do that, so a wrapper is used to create a fixed-length string of sufficient size and pass that to the function. wrapper does that well enough to suffice in most cases. Note that this should also work on OS X and Linux (and pretty much any other POSIX-like system that QB64 runs on, possibly even including Android). I haven't tested on those systems, but it should work since getcwd is a POSIX function.
What happens when that number isn't large enough? Well, QB64 doesn't allow arrays to be passed to library functions, and you can't use STRING * variable unless variable is CONST variable = .... That means you can't enlarge the string and try again. You should probably raise an error if that happens to to tell you that something went wrong (e.g. ERROR 75).

One way to get default directories of all drives in QB64 without error trapping:
REM get default directory of drives.
FOR D = 65 TO 90
D$ = CHR$(D) + ":"
IF _DIREXISTS(D$) THEN
CHDIR D$
PRINT _CWD$
END IF
NEXT
END

Have also noticed the default directory is not always the directory where a file was started from, so, here is a sample describing each:
' directory file was loaded from
PRINT _CWD$
' declare external libraries.
DECLARE DYNAMIC LIBRARY "kernel32"
FUNCTION SetCurrentDirectoryA% (f$)
END DECLARE
' force default path
x$ = _STARTDIR$
f$ = x$ + CHR$(0)
x = SetCurrentDirectoryA(f$)
' directory where user is in dos
PRINT _CWD$

Related

How to set Fortran variables from the input file?

I have an input file like this:
x = 1.5
y = 2.8
z = 9.4
x = 4.2
I want to set variable's values.
So, I do this:
read(1,'(A)', IOSTAT=io) str
if (io > 0) then !error
write(*,*) 'Check input. Something was wrong'
exit
else if (io < 0) then !EOF
exit
else !read new value
do i=1,len_trim(str)
if (str(i:i) == "=") str(i:i) = " " !replase "=" with spaces
end do
read(str, *) curvar, curval
SELECT CASE (curvar)
CASE ("x")
x = curval
CASE ("y")
y = curval
CASE ("z")
z = curval
END SELECT
Is it possible to set variable with name stored in "curvar" to be equal value from "curval" without "CASE SELECT"? I suppose that some easier way is exist. I need it because my program will have much more variables than three.
If you can change your file very slightly at the beginning and at the end, you can use a namelist. See, for example: http://jules-lsm.github.io/vn4.2/namelists/intro.html
&namelist_name
x = 1.5
y = 2.8
z = 9.4
/
with a simple Fortran code
namelist /namelist_name/ x, y, z
read(unit, nml = namelist_name)
Otherwise the answer is no, it is not possible to just assign a value to a variable with a certain name from a configuration file without parsing the name and using some conditional or select case or an array of pointers or something like that. The Fortran namelist I/O does that for your convenience.
Or there are libraries that can do similar work and allow configuration files of various forms. This answer discusses these options in the context of the command line arguments. There are various libraries for configuration files of various forms, but weather forecast and climate prediction models, for example, most often just use namelists. For my model I wrote my own parser, that gives more options for structured data, but it is not documented and would be harder to use for other people.

VBA: Set variable to "Empty" or "Missing"? Handling multiple optional arguments?

Is it possible, or desirable, to set objects/data to an "Empty" or "Missing" variant?
I want to be able to conditionally pass optional arguments to a function. Sometimes I want to use an optional argument, sometimes I don't.
In Python, you could easily pass through whichever optional arguments you wanted by using **kwdargs to unpack a dictionary or list into your function arguments. Is there something similar (or a way to hack it in VBA) so you can pass in Empty/Missing optional arguments?
In particular, I'm trying to use Application.Run with an arbitrary number of arguments.
EDIT:
I'm basically trying to do this:
Public Function bob(Optional arg1 = 0, Optional arg2 = 0, Optional arg3 = 0, Optional arg4 = 0)
bob = arg1 + arg2 + arg3 + arg4
End Function
Public Function joe(Optional arg1)
joe = arg1 * 4
End Function
Public Sub RunArbitraryFunctions()
'Run a giant list of arbitrary functions pseudocode
Dim flist(1 To 500)
flist(1) = "bob"
flist(2) = "joe"
flist(3) = "more arbitrary functions of arbitrary names"
flist(N) = ".... and so on"
Dim arglist1(1 To 4) 'arguments for bob
Dim arglist2(1 To 1) 'arguments for joe
Dim arglist3(1 To M number of arguments for each ith function)
For i = 1 To N
'Execute Application.Run,
'making sure the right number of arguments are passed in somehow.
'It'd also be nice if there was a way to automatically unpack arglisti
Application.Run flist(i) arglisti(1), arglisti(2), arglisti(3), ....
Next i
End Sub
Because the number of arguments changes for each function call, what is the acceptable way to make sure the right number of inputs are input into Application.Run?
The equivalent Python code would be
funclist = ['bob', 'joe', 'etc']
arglists = [[1,2,3],[1,2],[1,2,3,4,5], etc]
for args, funcs in zip(arglists, funclist):
func1 = eval(funcs)
output = func1(*args)
in VBA you use ParamArray to enter option inputs to functions.
See Pearson Material
There are two ways in which a routine can change the number of arguments that has to be provided to it:
declare some of the trailing arguments as Optional
declare the last argument as ParamArray
A single routine can use either or both.
An Optional parameter may have a strict type (e.g. Optional s As String), but then it will be impossible to detect whether it was passed. If you don't pass a value for such argument, the correct flavour of "blank" will be used, which is indistinguishable from passing that blank value manually.
So, having Public Sub Bob(Optional S As String), you cannot detect from inside of Bob whether it was called as Bob or as Bob vbNullString.
An optional parameter may have a default value, which suffers from the same problem. So, having Public Sub Bob(Optional S As String = "Default Value"), you cannot detect if Bob was called as Bob or as Bob "Default Value".
To be able to truly detect whether an optional parameter was passed, they have to be typed as Variant. Then a special function, IsMissing, can be used inside the routine to detect if a parameter was passed.
Public Sub Bob(Optional a, Optional b, Optional c, Optional d)
Debug.Print IsMissing(a), IsMissing(b), IsMissing(c), IsMissing(d)
End Sub
Bob 1, , 3 ' Prints False, True, False, True
ParamArray can only be the last argument, and it allows an infinite* number of arguments to be passed starting from this position. All these arguments arrive packed in a single Variant array (no option for static typing here).
The IsMissing function does not work on the ParamArray argument (always returns False). The way to know how many arguments were passed is to compare UBound(args) with LBound(args). Note that this only tells you how many argument "slots" were used, but some of them can be in fact missing!
Public Sub BobArray(ParamArray a())
Dim i As Long
For i = LBound(a) To UBound(a)
Debug.Print IsMissing(a(i)), ;
Next
Debug.Print
End Sub
BobArray ' Prints empty line (the For loop is not entered due to UBound < LBound)
Sheet1.BobArray 1, 2, 3 ' Prints False, False, False
Sheet1.BobArray 1, , 3 ' Prints False, True, False
Note that you cannot pass "missing" value for the trailing arguments of the ParamArray, i.e. this is illegal:
Sheet1.BobArray 1, , 3, ' Does not compile
However, you can work around this using the trick described below.
An interesting use case that you touch in your question is preparing an array of all arguments in advance, passing it to the function, filling all the arguments "placeholders", but still expecting the function to detect that some of the arguments are missing (not passed).
Normally this is not possible, because if anything is passed (even "blank" values, such as Empty, Null, Nothing of vbNullString), then it still counts as passed, and IsMissing() will return False.
Fortunately, the special Missing value is nothing but a specially constructed Variant, and even without knowing how to construct that value manually, we can trick the compiler to give it away:
Public Function GetMissingValue(Optional ByVal IgnoreMe As Variant) As Variant
If IsMissing(IgnoreMe) Then
GetMissingValue = IgnoreMe
Else
Err.Raise 5, , "I told you to ignore me, didn't I"
End If
End Function
Dim missing As Variant
missing = GetMissingValue()
Dim arglist1(1 To 4) As Variant
arglist1(1) = 42
arglist1(2) = missing
arglist1(3) = missing
arglist1(4) = "!"
Bob arglist1(1), arglist1(2), arglist1(3), arglist1(4) ' Prints False, True, True, False
Now, we can work around the inability to pass "missing" to the trailing "slots" of ParamArray:
Dim arglist1(1 To 4) As Variant
arglist1(1) = 42
arglist1(2) = missing
arglist1(3) = missing
arglist1(4) = missing
BobArray arglist1(1), arglist1(2), arglist1(3), arglist1(4) ' Prints False, True, True, True
Note, however, that this workaround will only work if you call BobArray directly. If you use Application.Run, it will not work because the Run method will discard any trailing "missing" arguments before passing them onto the called routine:
Dim arglist1(1 To 4) As Variant
arglist1(1) = 42
arglist1(2) = missing
arglist1(3) = missing
arglist1(4) = missing
Application.Run "BobArray", arglist1(1), arglist1(2), arglist1(3), arglist1(4)
' Prints False, because only one argument is passed
Further to #GSerg's very comprehensive answer (I don't have enough reputation just to comment), the 'special' value assigned to a Missing argument has the 'appearance' of being an Error value - it converts to "Error 448" (Named argument not found) using CStr(), and responds to IsError() as TRUE. However, an attempt to preset the argument using CvErr(448) before passing to a procedure (in the hope that it will be recognised as Missing) fails, perhaps because the value is 'not quite' the same as the Error value in some way.
#GSerg suggested a method of 'recording' the value actually passed by the compiler when an argument is missing and using that to preset a dummy argument prior to passing to the procedure needing to be fooled. This method, indeed, does work and I have simply extended #GSerg's function to replace his error message (if it is inadvertently called with an argument) by a recursive call without an argument which ensures a successful outcome either way. Usage is simply to preset the dummy variable(s) before passing to a procedure (where it/they will then be treated as missing): Dummy_Var = Missing().
Public Function Missing(Optional ByVal X As Variant) As Variant
If IsMissing(X) Then 'correctly called
Missing = X
Else 'bad user call
Missing = Missing() 'recursive call (no arg!)
End If
End Function
I have just done a quick trial with Application.Run. Early embedded 'missing' arguments (ie, followed by 'normal' ones) appear to be successfully registered as 'missing' in the called procedure. So, too, however, are final trailing 'missing' arguments - whether actually passed by the Run method, or truncated (as suggested by #GSerg), but still filled in by the compiler as genuinely missing.
Interestingly, and usefully (to a niche market), additional 'missing' arguments (beyond those defined by the procedure) appear to be tolerated by the compiler without generating the 'Wrong number of arguments' message associated with extra 'normal' arguments. This opens up the possibility of procedure calls using Application.Run (when a variable number of arguments is desired) being implemented by a single universal call (with up to 30 arguments if necessary) padded out with fake 'missing' arguments instead of having to provided several alternative calls of different lengths and/or argument configurations to cope with exact procedure definitions.
So addressing the question of optionally using arguments it looks like my question in Calling vba macro from python with unknown number of arguments, check it out accordingly.
Hence:
Using Python:
def run_vba_macro(str_path, str_modulename, str_macroname, **kwargs):
if os.path.exists(str_path):
xl=win32com.client.DispatchEx("Excel.Application")
wb=xl.Workbooks.Open(str_path, ReadOnly=0)
xl.Visible = True
if kwargs:
params_for_excel = list(kwargs.values())
xl.Application.Run(os.path.basename(str_path)+"!"+str_modulename+'.'+str_macroname,
*params_for_excel,)
else:
xl.Application.Run(os.path.basename(str_path)
+"!"+str_modulename
+'.'+str_macroname)
wb.Close(SaveChanges=0)
xl.Application.Quit()
del xl
#example
kwargs={'str_file':r'blablab'}
run_vba_macro(r'D:\arch_v14.xlsm',
str_modulename="Module1",
str_macroname='macro1',
**kwargs)
#other example
kwargs={'arg1':1,'arg2':2}
run_vba_macro(r'D:\arch_v14.xlsm',
str_modulename="Module1",
str_macroname='macro_other',
**kwargs)
Using VBA:
Sub macro1(ParamArray args() as Variant)
MsgBox("success the str_file argument was passed as =" & args(0))
End Sub
Sub macro_other(ParamArray args() as Variant)
MsgBox("success the arguments have passed as =" & str(args(0)) & " and " & str(args(1)))
End Sub
Also another use case only using VBA is here for reference. It is a question that has not been answered and is around for long, although recently it was updated by the community server automatically with some good ideas related links accordingly.
Here is an answer you can do it if you use this:
Sub pass_one()
Call flexible("a")
End Sub
Sub pass_other()
Call flexible("a", 2)
End Sub
Sub flexible(ParamArray args() As Variant)
Dim i As Long
MsgBox ("I have received " & _
Str(UBound(args) + 1) & _
" parameters.")
For i = 0 To UBound(args)
MsgBox (TypeName(args(i)))
Next i
End Sub
Only for developers that also use Python:
If you are using Python's kwargs, simply starr expression and pass a Python tuple.
Here it is (it is related with my question in Calling vba macro from python with unknown number of arguments)
Cheers.

Lua: Fastest Way to Read Data

Here's my program.
local t = {}
local match = string.gmatch
local insert = table.insert
val = io.read("*a")
for num in match(val, "%d+") do
insert(t, num)
end
I'm wondering if there is a faster way to load a large (16MB+) array of integers than this. Considering the data is composed of line after line of a single number can this be made faster? Should I be looking at io.read("*n") instead?
Given that your file size is 16MB, your loading routine's performance will be dominated by file IO. How long it takes you to process the loaded data will generally be irrelevant next to that.
Just try it; profile how long it takes to just load the file (stopping the script after io.read), then profile how long the whole script takes. The latter will be longer, but it's only going to be by some relatively small percentage, not vast amounts.
Loading the whole file at once the way you're doing will almost certainly be faster than doing it piecemeal. Filesystems like reading entire blocks of data all at once, rather than bits at a time. Beyond that, how to process the text is relatively irrelevant.
I'm not sure if its faster, but read("*n") is much simpler...
local t = { }
while true do
local n = io.stdin:read("*n")
if n == nil then break end
table.insert ( t , n )
end
Probably, this would be faster:
local t = {}
local match = string.match
for line in io.lines() do
t[#t+1] = match(line, '%d+')
end
Don't forget to convert strings to numbers.

Function arguments VBA

I have these three functions:
When I run the first 2 functions, There's no problem, but when I run the last function (LMTD), It says 'Division by zero' yet when I debug some of the arguments have values, some don't. I know what I have to do, but I want to know why I have to do it, because it makes no sense to me.
Tinn-function doesn't have Tut's arguments, so I have to add them to Tinn-function's arguments. Same goes for Tut, that doesn't know all of Tinn's arguments, and LMTD has to have both of Tinn and Tut's arguments. If I do that, it all runs smoothly. Why do I have to do this?
Public Function Tinn(Tw, Qw, Qp, Q, deltaT)
Tinn = (((Tw * Qw) + (Tut(Q, fd, mix) * Q)) / Qp) + deltaT
End Function
Public Function Tut(Q, fd, mix)
Tut = Tinn(Tw, Qw, Qp, Q, deltaT) _
- (avgittEffektAiUiLMTD() / ((Q * fd * mix) / 3600))
End Function
Public Function LMTD(Tsjo)
LMTD = ((Tinn(Tw, Qw, Qp, Q, deltaT) - Tsjo) - (Tut(Q, fd, mix) - Tsjo)) _
/ (WorksheetFunction.Ln((Tinn(Tw, Qw, Qp, Q, deltaT) - Tsjo) _
/ (Tut(Q, fd, mix) - Tsjo)))
End Function
I will try to give a useful and complete explanation on how arguments are being passed:
As far as I can tell, LMTD is the main function calling the other function.
Each time a new function is called, it is placed on top of what they call the "stack";
The principle of Stack involves that memory is allocated and deallocated at one end of the memory (top of the stack): memory is allocated to those local variables declared and used in the function on top of the stack (function that is called gets in scope and forms a new layer on top of the stack) while these local variables are being released as soon as the function goes out of scope (when the value is returned). Something generally referred to as "Last In First Out" (LIFO).
So if you consider LMTD the base (which is probably not the ultimate base, since it is must be called by another sub routine or function), Tinn and Tut are placed on top of the stack whenever these functions are being called.
However (and here is the point),
Variables not locally declared in functions and passed as argument are standard passed by Reference, they are pointer variables containing the memory address of the arguments sent by the function (or sub) on the lower layer of the stack.
When a function takes parameters by reference (default), it can change the values contained by the memory addresses that are passed and thus the original variable value can be changed when the called function is returned.
This example illustrates it:
Sub Base_Sub()
Dim i as single
Dim c as single
Dim d as single
c = 5
d = 6
i = Function_1(c, d)
End Sub
Function Function_1(c, d)
c = 7 'Notice that the variables c and d are also changed in the Base_sub
d = 5
Function_1 = c + d
End Function
On the contrary, if you would send variable by value (byVal keyword), this would mean that a copy of the original variable (that is passed as argument) is made and the original variable remains untouched while the copy is being manipulated in the function. In other words, this copy would become a local variable on top of the stack and released as soon as the function goes out of scope.
So without looking into dept into your code to deep, when you call many functions in one routine, it may help you to keep this general concept of the different layers in mind.
In order to keep an eye on your local variables, use the "locals" window in VBA for follow-up or use debug.print to follow up in the immediate window.
What could help you gain more transparency regarding the error is by performing a check. For example
for Tinn function:
If QP = 0 then
'Notify problem at QP.
end if
I'm sorry if my explanation was more than you expected, but I tried to be as complete as possible on this one.

How can I create function pointers from a string input in MATLAB?

If I use the inline function in MATLAB I can create a single function name that could respond differently depending on previous choices:
if (someCondition)
p = inline('a - b','a','b');
else
p = inline('a + b','a','b');
end
c = p(1,2);
d = p(3,4);
But the inline functions I'm creating are becoming quite epic, so I'd like to change them to other types of functions (i.e. m-files, subfunctions, or nested functions).
Let's say I have m-files like Mercator.m, KavrayskiyVII.m, etc. (all taking a value for phi and lambda), and I'd like to assign the chosen function to p in the same way as I have above so that I can call it many times (with variable sized matrices and things that make using eval either impossible or a total mess).
I have a variable, type, that will be one of the names of the functions required (e.g. 'Mercator', 'KavrayskiyVII', etc.). I figure I need to make p into a pointer to the function named inside the type variable. Any ideas how I can do this?
Option #1:
Use the str2func function (assumes the string in type is the same as the name of the function):
p = str2func(type); % Create function handle using function name
c = p(phi, lambda); % Invoke function handle
NOTE: The documentation mentions these limitations:
Function handles created using str2func do not have access to variables outside of their local workspace or to nested functions. If your function handle contains these variables or functions, MATLABĀ® throws an error when you invoke the handle.
Option #2:
Use a SWITCH statement and function handles:
switch type
case 'Mercator'
p = #Mercator;
case 'KavrayskiyVII'
p = #KavrayskiyVII;
... % Add other cases as needed
end
c = p(phi, lambda); % Invoke function handle
Option #3:
Use EVAL and function handles (suggested by Andrew Janke):
p = eval(['#' type]); % Concatenate string name with '#' and evaluate
c = p(phi, lambda); % Invoke function handle
As Andrew points out, this avoids the limitations of str2func and the extra maintenance associated with a switch statement.

Resources