In my Delphi Rio application I use a lot of 2 dimensions Dynamic Arrays. In order to speed up some operations I'd like to use move command instead of copy. I could make it work for 1D dynamic arrays, but for 2D or higher I could not. For the second dimension, after issued move(A,B,size) the elements of array B point to the same memory address of elements of array A, i.e. B references A. In fact I want to work with B separetely of A. See my code :
program ProjArrayMove;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
Type
Arrayint = Tarray<Integer>;
Arrayreal = TArray<Real>;
MatrixInt = Array of Arrayreal;
var
vectorA, vectorB : Arrayint;
matA, matB : MatrixInt;
idx,idy : integer;
begin
TRY
// =============== TESTING WITH 1D DYNAMIC ARRAYS OF SIMPLE TYPES ==================
Writeln('==============================================================');
Writeln('========= TESTING 1-DIMENSION DYNAMIC ARAYS ==================');
Writeln('===============================================================');
readln;
Writeln('------- Fills Vector A ----------------------------');
SetLength(vectorA,5);
for idx :=0 to 4 do
begin
vectorA[idx] := (idx+1) * 10;
Writeln('VectorA : [' + idx.tostring + '] ' +
Format('Address : %p [%d]' ,[PPointer(#VectorA), VectorA[idx] ]) );
end;
readln;
Writeln('--------------------------------------------------');
Writeln('------ Moves VectorA to VectorB ------------------');
SetLength(VectorB,Length(vectorA));
Move(VectorA[0],VectorB[0],SizeoF(VectorA[0]) * Length(VectorA));
for idx :=0 to 4 do
Writeln('VectorB : [' + idx.tostring + '] ' +
Format('Address : %p [%d]' ,[PPointer(#VectorB), VectorB[idx] ]) );
readln;
Writeln('---------------------------------------------------');
Writeln('------ Changes VectorB contents ------------------');
for idx :=0 to 4 do
begin
vectorB[idx] := (idx+1) * 200;
Writeln('VectorB : [' + idx.tostring + '] ' +
Format('Address : %p [%d]' ,[PPointer(#VectorB), VectorB[idx] ]) );
end;
readln;
Writeln('--------------------------------------------------');
Writeln('------ Checking Vector A ------------------------');
for idx :=0 to 4 do
Writeln('VectorA : [' + idx.tostring + '] ' +
Format('Address : %p [%d]' ,[PPointer(#VectorA), VectorA[idx] ]) );
Writeln;
Writeln('CONCLUSION : ===>> MOVE command works fine for 1-Dimension Dynamic Arrays!');
readln;
//=========================== TESTING WITH MATRIX 2D DYNAMIC ARRAYS OF SIMPLE TYPES ==================
Writeln('===============================================================');
Writeln('========= TESTING 2-DIMENSIONS DYNAMIC ARAYS ==================');
Writeln('===============================================================');
readln;
Writeln('------ Fills MatrixA -----------------------------');
SetLength(matA,5,2);
for idx :=0 to 4 do
for idy := 0 to 1 do
begin
matA[idx][idy] := (idx +1) * (idy +1);
Writeln('Mat A : [' + idx.tostring + '][' + idy.tostring +'] ' +
Format('Address : %p [%f]' ,[PPointer(#matA[idx][idy]), matA[idx][idy] ] ));
end;
readln;
Writeln('-------------------------------------------------');
Writeln('------ Move MatrixA to MatrixB ------------------');
SetLength(matB,length(matA));
//move(matA[0],MatB[0],Sizeof(matA[0]) * length(matA));
move(matA,MatB,Sizeof(matA[0]) * length(matA));
for idx :=0 to 4 do
begin
Setlength(MatB[idx],length(matA[idx]));
//Move(matA[idx][0],matB[idx][0],sizeof(matB[idx][0]) * length(matB[idx]) );
Move(matA[idx],matB[idx],sizeof(matB[idx][0]) * length(matB[idx]) );
for idy := 0 to 1 do
begin
Writeln('Mat B : [' + idx.tostring + '][' + idy.tostring +'] ' +
Format('Address : %p [%f]' ,[PPointer(#matB[idx][idy]), matB[idx][idy] ] ));
end;
end;
readln;
Writeln('-------------------------------------------------');
Writeln('------ Change MatrixB content ------------------');
readln;
for idx :=0 to 4 do
for idy := 0 to 1 do
begin
matB[idx][idy] := 100.5 * (idx+1) * (idy +1);
Writeln('Mat B : [' + idx.tostring + '][' + idy.tostring +'] ' +
Format('Address : %p [%f]' ,[PPointer(#matB[idx][idy]), matB[idx][idy] ] ));
end;
Writeln('-------------------------------------------------');
Writeln('------ Checking Matrix A ------------------------');
readln;
for idx :=0 to 4 do
for idy := 0 to 1 do
Writeln('Mat A : [' + idx.tostring + '][' + idy.tostring +'] ' +
Format('Address : %p [%f]' ,[PPointer(#matA[idx][idy]), matA[idx][idy] ] ));
Writeln;
Writeln('CONCLUSION : ===>> MOVE command DOES NOT WORK on 2-Dimensions Dynamic Arrays!');
readln;
except
on E: Exception do
begin
Writeln(E.ClassName, ': ', E.Message);
readln;
end;
end;
end.
Is there something wrong or missing in move command for the second dimension?
Thanks !
Your problems start here:
Move(matA, matB, Sizeof(matA[0]) * Length(matA));
You are passing a dynamic array to Move. A dynamic array is implemented as a pointer to the first element of the array. You are therefore overwriting the pointer.
Perhaps you wanted to do something like this:
Move(matA[0], matB[0], Sizeof(matA[0]) * Length(matA));
But you don't want to do that either. That's using Move on a managed type, which is exactly the same mistake that you made in your previous question.
In fact if you just remove that line of code it should work. Note I've not checked in detail so there may be other defects.
Your code is really extremely complex, and it's very hard to see what is going on. At least some of your problems are due to your code being so obfuscated. Try to stop putting huge amounts of code into a single procedure. Split the code up into smaller parts, and then glue these smaller parts together in a driver routine.
You want to use a function like this:
function CloneMatrixInt(const matrix: array of ArrayInt): MatrixInt;
var
i: Integer;
begin
SetLength(Result, Length(matrix));
for i := 0 to High(Result) do
Result[i] := Copy(matrix[i]);
end;
Notice that this is essentially identical to the answer to your previous question. Why is that?
You need to stop thinking of MatrixInt as a multidimensional array. It's not. It's just an array. It's an array whose elements are in turn also arrays. Technically it is a jagged array. But you just need to think of it as a single dimensional array.
So the function to clone it operates as follows:
Allocate the destination array.
Loop over the destination array cloning each element from the source array.
That's exactly the same process as in your previous question. There we had an array of record with a function to clone that record. But because we had separated the two tasks of cloning the outer array from cloning the elements of the array, the resulting code is essentially identical.
Now imagine you had an array of MatrixInt. Let's say
type
ArrayMatrixInt = array of MatrixInt;
Well, clone that like this:
function CloneArrayMatrixInt(const arrayMatrix: array of MatrixInt): ArrayMatrixInt;
var
i: Integer;
begin
SetLength(Result, Length(arrayMatrix));
for i := 0 to High(Result) do
Result[i] := CloneMatrixInt(matrix[i]);
end;
Guess what, the exact same code as before!
Given this question, and your previous one, can I please suggest that you refrain from trying to use Move to solve all problems. There's no reason to suggest that any of the problems you are encountering are going to be solved by using Move.
One final note. Jagged arrays are expensive to allocate because they require multiple allocations. They are also inefficient to operate on because they are not stored contiguously. Delphi lacks a multidimensional array type, and if ultimate performance is required then you may be best to implement multidimensional array type.
Related
I have a problem with Pascal, especially Lazarus.
First of all, I created two random arrays of integer:
procedure TForm1.b_arraycreate1Click(Sender: TObject);
begin
randomize;
for i := 1 to 5 do
arr1[i] := random(10);
end;
And
procedure TForm1.b_arraycreate2Click(Sender: TObject);
begin
randomize;
for j := 1 to 5 do
arr2[j] := random(10);
end;
I know, I could put it in one procedure as well but doesn't matter now.
I want to compare these two. I wrote the following code:
procedure TForm1.b_comparisonClick(Sender: TObject);
var v:boolean;
begin
for i := 1 to 5 do begin
for j := 1 to 5 do begin
if arr1[i] = arr2[j]
then
begin
v:=true;
end
else
begin
v:=false;
end;
end;
end;
if v = true
then
begin
ShowMessage('Yes, there is a similarity! You can find number ' +IntToStr(arr1[i])+ ' in array 1, position ' +IntToStr(i)+ ' and also in array 2, position ' +IntToStr(j)+ '.');
end
else
begin
ShowMessage('No similarities... Generate new ones!');
end
end;
In my own words: I want to push a button and then there should be a message window with the information if there is one number (for example 7) which exists in array 1 and array 2. If yes, it should also write the position (index) of this number.
Unfortunately, this program doesn't work and I don't know why. It always shows "No similarities" (and don't worry about the creation of the arrays. I also have a label where I can test the content of the arrays every time).
Is there a (silly) mistake in my code here?
As explained already by MartynA in his comment, your algorithm is wrong. Your words are:
if there is one number which exists in array 1 and array 2
To see if it is so, you must scan all array1 and, for each number, see if it exists somewhere in array2.
So yes, you need two cycles, one nested in the other. As soon as you find a correspondence, you must stop. Or, if you want more results (find multiple duplicates), show a message instead of stopping - and go ahead. Third possibility (more complicated): when found, store the couple of indexes (without overwrite old results...) and go ahead. I will only show the first option:
procedure TForm1.b_comparisonClick(Sender: TObject);
var
i,j: integer;
v: boolean;
begin
v := false;
for i := 1 to 5 do begin
for j := 1 to 5 do begin
if arr1[i] = arr2[j] then begin
v := true;
break
end
end // inner, j
end; // outer, i
if v = true
then ShowMessage(.....)
else ShowMessage('No similarities...');
end; // proc comparison
I tried to respect your code a bit, there are a few possible "shortcuts"; for example, if v is a boolean variable, it is better to write if v then instead of if v=true then, and some others, like
v := arr1[i]=arr[j];
...or... the outer loop does not need begin+end.
******* BEWARE (see comment below about break)
To stop/exit from two nested cycle is not so simple... perhaps a goto... the code above works, but the break does little work.
******* second update, as described by comment below. IT DOES NOT WORK, because if the break does not exit BOTH loops, the outer index gets modified. The correct cycle using TWO breaks is as follows:
for i := 1 to 5 do begin
for j := 1 to 5 do begin
if arr1[i] = arr2[j] then begin
v := true;
break
end
end; // inner, j
if v then break
end; // outer, i
Sorry for the mistakes... :-)
I would prefer a GOTO to exit both loops: it is faster, single instruction, and more clear ("goto found" instead of a generic break). But GOTOs are not very popular... so I've been afraid!
This question already has an answer here:
Lazarus readln doesn't read the variable
(1 answer)
Closed 4 years ago.
I have a small code where I want to initialize an array of records by fields and then just output this records on screen.
Data types:
type
grade = 1..5;
Person = record
Name: string[16];
isMale: boolean;
grades: array [1..6] of grade;
end;
var
Table: array [1..10] of Person;
R: Person;
N,J,I: Integer;
Part of code with initialization and output:
readln(n);
if N>10 then N:=10; if N<1 then N:=1;
for I:=1 to N do begin
R:=Table[I];
//write('Gender?'); readln(j); R.isMale:=j>=0; <= This works just fine
write('Name? '); readln(R.Name);
write('Gender? '); readln(j); R.isMale:=j>=0;
write('Grades? '); for j:=1 to 6 do read(R.grades[J]); writeln;
end;
for I:=1 to N do begin
R:=Table[I];
write(I,' ', R.Name,' ',R.isMale);
end;
When I enter info about first person it works fine, but then every other person's name input is skipped (output is "Name? Gender? ). If I switch entering boolean and string, code works correct, but that's not a logic order.
Why is this happening?
At the end of the loop, you should assign the record to the array. Note that, unlike with classes, assigning a record copies the data in the record, it does not reference the record. So instead of what you have, rather do:
for I := 1 to N do
begin
//write('Gender?'); readln(j); R.isMale:=j>=0; <= This works just fine
write('Name? ');
readln(R.Name);
write('Gender? ');
readln(j);
R.isMale := j >= 0;
write('Grades? ');
for j := 1 to 5 do
read(R.grades[J]);
readln(R.grades[6]); // readln reads the end-of-line too.
writeln;
Table[I] := R; // copy the data from R into the table
end;
That way, the data from the record R is copied into the table. There is no need to copy R from the table at the beginning of the loop, as the table is empty anyway.
Unlike with classes, with records like this, you could do the following too:
write('Name? ');
readln(Table[I].Name);
write('Gender? ');
readln(j);
Table[I].isMale := j >= 0;
// etc...
And in the final loop:
Writeln(I, ' ', Table[I].Name, ' ', Table[I].IsMale);
without using R at all.
I am making a Matchmaking server for my custom Battleship game. I am a beginner at network coding, so I am sorry in advance for dumb questions. :P
Now closer to the topic. I use default Delphi Server/Client Socket component. I have my array declared in the public section (clients: array of TCustomWinSocket;), then on the main frame startup I set the length to zero (setLength(clients, 0);). Now the confusing part for me: whenever I try to access any element of array program throws an Access Violation exception. I have checked in any known way, program NEVER exceeds the length of the array.
Here is code example which throws exception:
procedure Tmain.Button1Click(Sender: TObject);
var
i: integer;
begin
for i := 0 to length(clients) do begin
if assigned(clients[i]) then begin
showmessage(IntToStr(i));
showmessage(IntToStr(i) + ': ' + clients[i].RemoteAddress);
end;
end;
end;
Another example:
procedure Tmain.serverClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
addLog('(' + Socket.RemoteAddress + ':' + IntToStr(Socket.RemotePort) + ') Клиент подключился');
if length(clients) <> 0 then begin
showmessage(IntToStr(length(clients)));
setLength(clients, length(clients) + 1);
showmessage(IntToStr(length(clients)));
clients[length(clients)] := Socket;
end
else if length(clients) = 0 then begin
showmessage(IntToStr(length(clients)));
clients[0] := Socket;
end;
end;
Basically, every time I use this array it gives an access violation. I can't get it, I limit the code to stay in the array length, but it does not. Or, perhaps, it is as usual my stupidity that caused it?
Any way, I could really use some help.
Thanks in advance! :)
You're running off the end of the array in this loop. Length(clients) is one higher than the last index, because the index into a dynamic array starts at zero. You have to either use Length(clients) - 1 or High(clients) as the terminator of your loop.
procedure Tmain.Button1Click(Sender: TObject);
var
i: integer;
begin
for i := 0 to High(clients) do begin // or Length(clients) - 1
if assigned(clients[i]) then begin
showmessage(IntToStr(i));
showmessage(IntToStr(i) + ': ' + clients[i].RemoteAddress);
end;
end;
end;
You have a similar error in your second code block as well, plus another one that's pretty clear:
procedure Tmain.serverClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
addLog('(' + Socket.RemoteAddress + ':' + IntToStr(Socket.RemotePort) + ') Клиент подключился');
if length(clients) <> 0 then begin
showmessage(IntToStr(length(clients))); // Need - 1 or High() here
setLength(clients, length(clients) + 1);
showmessage(IntToStr(length(clients))); // Need - 1 or High() here
clients[length(clients)] := Socket;
end
else if length(clients) = 0 then begin // Second problem starts here
showmessage(IntToStr(length(clients))); // See text below
clients[0] := Socket;
end;
end;
The second error is attempting to assign to clients[0] when Length(clients) = 0, because that's an invalid index. If the array length is zero, there is no element 0, because the array is empty - there are no elements in it - not a single one; you can't assign a value to an array that has zero elements in it.
The proper code for that entire block would be something like this - you don't need both tests, to test for length = 0, or to jump through all the hoops:
procedure Tmain.ServerClientConnect(Sender: TObject; Socket; TCustomSocket);
begin
AddLog('Whatever you want to log.');
SetLength(clients, Length(clients) + 1);
Clients[High(Clients)] := Socket;
end;
I have set a connection from Delphi to pgsql using ADOConnection, ADOQuery, DataSource and a DBGrid to present the results of my query.
The database contains 2 columns of values of type double, of some thousands of rows, which I would like to insert into a two-dimensional array.However, as am quite new I am not sure how to insert the contents of a DBGrid into an array. Any help much appreciated.
First of all if there are thousands of rows you need to assign fields into variables before reading to get rid of unnecessary text lookup time when using FieldByName.
I dont't have Delphi at hand but this should work or at least help you get started.
uses Math;
procedure ProcessArray(ADataSet: TDataSet);
var
field1: TField;
field2: TField;
len: Integer;
a: array of array[2] of double;
begin
len := 0;
SetLength(a, 0);
field1 := ADataSet.FieldByName('field1');
field2 := ADataSet.FieldByName('field2');
ADataSet.First;
while not ADataSet.Eof do
begin
Inc(len);
if len > Length(a) then
SetLength(a, len + Min(len, 16384));
a[len - 1][0] := field1.Value;
a[len - 1][1] := field2.Value;
ADataSet.Next;
end;
SetLength(a, len);
// Process the results in the a array
end;
What AlexSC is suggesting is to actually use TADODataSet.RecordCount property to set the size of an array initially. Please note that if TDataSet is not loaded completely from the database (uses server cursor for example), RecordCount will not necessarily contain the number of all records and the original solution above would be able to cope with this. I made a correction to it so it won't grow more than 16k items at once and the overhead will be at most 16k - 1 array entries. For information about TDataSet "lazy loading" refer to DBGrid with read ahead capability using ADO
Please find the code using RecordCount below:
procedure ProcessArray(ADataSet: TDataSet);
var
field1: TField;
field2: TField;
len: Integer;
a: array of array[2] of double;
begin
len := 0;
SetLength(a, ADataSet.RecordCount);
field1 := ADataSet.FieldByName('field1');
field2 := ADataSet.FieldByName('field2');
ADataSet.First;
while not ADataSet.Eof do
begin
a[len][0] := field1.Value;
a[len][1] := field2.Value;
Inc(len);
ADataSet.Next;
end;
// Process the results in the a array here
end;
This is Oracle 11.2g. In a PL/SQL function, I've got a loop whereby each iteration, I create a string and an integer associated with that string. The function returns the final concatenation of all the generated strings, sorted (depending on a function input parameter), either alphabetically or by the value of the integer. To give an idea, I'm generating something like this:
Iteration String Integer
1 Oslo 40
2 Berlin 74
3 Rome 25
4 Paris 10
If the input parameter says to sort alphabetically, the function output should look like this :
Berlin, Oslo, Paris, Rome
Otherwise, we return the concatenated strings sorted by the value of the associated integer:
Paris, Rome, Oslo, Berlin
What is the most appropriate data structure to achieve this sort? I've looked at collections, associative arrays and even varrays. I've been kind of shocked how difficult this seems to be to achieve in Oracle. I saw this question but it doesn't work in my case, as I need to be able to sort by both index and value: How to sort an associative array in PL/SQL? Is there a more appropriate data structure for this scenario, and how would you sort it?
Thanks!
It is very easy if you use PL/SQL as SQL and not like other languages. It is quite specific and sometimes is very nice exactly because of that.
Sometimes I really hate PL/SQL, but this case is absolutely about love.
See how easy it is:
create type it as object (
iter number,
stringval varchar2(100),
intval integer
);
create type t_it as table of it;
declare
t t_it := new t_it();
tmp1 varchar2(32767);
tmp2 varchar2(32767);
begin
t.extend(4);
t(1) := new it(1,'Oslo',40);
t(2) := new it(2,'Berlin',74);
t(3) := new it(3,'Rome',25);
t(4) := new it(4,'Paris',10);
select listagg(stringval,', ') within group (order by stringval),
listagg(stringval,', ') within group (order by intval)
into tmp1, tmp2
from table(t);
dbms_output.put_line(tmp1);
dbms_output.put_line(tmp2);
end;
/
drop type t_it;
drop type it;
Here you can see the problem that you must create global types, and this is what I hate it for. But they say in Oracle 12 it can be done with locally defined types so I am waiting for it :)
The output is:
Berlin, Oslo, Paris, Rome
Paris, Rome, Oslo, Berlin
EDIT
As far as you do not know the amount of iterations from the beginning the only way is to do extend on each iteration (this is only example of extending):
declare
iterator pls_integer := 1;
begin
/* some type of loop*/ loop
t.extend();
-- one way to assign
t(t.last) := new it(1,'Oslo',40);
-- another way is to use some integer iterator
t(iterator) := new it(1,'Oslo',40);
iterator := iterator + 1;
end loop;
end;
I prefer the second way because it is faster (does not calculate .last on each iteration).
This is an example of pure PL/SQL implementation that is based on the idea associative array (aka map or dictionary in other domains) is an ordered collection that is sorted by a key. That is a powerful feature that I have used multiple times. For input data structure in this example I decided to use a nested table of records (aka a list of records).
In this particular case however I'd probably go for similar implementation than in simon's answer.
create or replace package so36 is
-- input data structures
type rec_t is record (
iter number,
str varchar2(20),
int number
);
type rec_list_t is table of rec_t;
function to_str(p_list in rec_list_t, p_sort in varchar2 default 'S')
return varchar2;
end;
/
show errors
create or replace package body so36 is
function to_str(p_list in rec_list_t, p_sort in varchar2 default 'S')
return varchar2 is
v_sep constant varchar2(2) := ', ';
v_ret varchar2(32767);
begin
if p_sort = 'S' then
-- create associative array (map) v_map where key is rec_t.str
-- this means the records are sorted by rec_t.str
declare
type map_t is table of rec_t index by varchar2(20);
v_map map_t;
v_key varchar2(20);
begin
-- populate the map
for i in p_list.first .. p_list.last loop
v_map(p_list(i).str) := p_list(i);
end loop;
v_key := v_map.first;
-- generate output string
while v_key is not null loop
v_ret := v_ret || v_map(v_key).str || v_sep;
v_key := v_map.next(v_key);
end loop;
end;
elsif p_sort = 'I' then
-- this branch is identical except the associative array's key is
-- rec_t.int and thus the records are sorted by rec_t.int
declare
type map_t is table of rec_t index by pls_integer;
v_map map_t;
v_key pls_integer;
begin
for i in p_list.first .. p_list.last loop
v_map(p_list(i).int) := p_list(i);
end loop;
v_key := v_map.first;
while v_key is not null loop
v_ret := v_ret || v_map(v_key).str || v_sep;
v_key := v_map.next(v_key);
end loop;
end;
end if;
return rtrim(v_ret, v_sep);
end;
end;
/
show errors
declare
v_list so36.rec_list_t := so36.rec_list_t();
v_item so36.rec_t;
begin
v_item.iter := 1;
v_item.str := 'Oslo';
v_item.int := 40;
v_list.extend(1);
v_list(v_list.last) := v_item;
v_item.iter := 2;
v_item.str := 'Berlin';
v_item.int := 74;
v_list.extend(1);
v_list(v_list.last) := v_item;
v_item.iter := 3;
v_item.str := 'Rome';
v_item.int := 25;
v_list.extend(1);
v_list(v_list.last) := v_item;
v_item.iter := 4;
v_item.str := 'Paris';
v_item.int := 10;
v_list.extend(1);
v_list(v_list.last) := v_item;
dbms_output.put_line(so36.to_str(v_list));
dbms_output.put_line(so36.to_str(v_list, 'I'));
end;
/
show errors