So guys... I've read aroung A LOT and I've tried using addons like madExcept (which I'm new to) but I've so far been unable to determine whats causing my errors.
I'm getting EAccessViolation Exceptions on my code when calling SetLength() at seemingly random times. I have been unable to determine the reason behind it and I can't even track it down to a single line of code. I'd like you to please help me sort it out.
This function is supposed to look for repeated patterns in a number array and count them.
Currently, its logic is still not 100% ready, but I want to correct these bugs before I proceed.
An example of how it will work when done:
Given the array {1, 2, 3, 4, 1, 2, 3, 5}, the function it will compare the subarray (1, 2, 3) to all other possible subarrays like (4, 1, 2), (1, 2, 3) and (2, 3, 5), counting the cases when they are the same. The function will then proceed to the next length and begin once again by comparing (1, 2, 3, 4) to (1, 2, 3, 5)...
The maximum array lenght is 45.
The minimum subarray length is 3.
The EAccessViolation error usually happens at array length 12-13 and usually at the last iteration of the first loop.
Once again, I know there are flaws on the algorithm logic itself, but I really wanna fix the memory stuff first.
Thank you very much.
function TfrmMain.Ready(Numbers: Array of SmallInt): SmallInt;
var
i: Integer;
Length, MinLength, MaxLength: SmallInt;
Array1, Array2: Array of SmallInt;
Array1Pos, Array1FirstPos, Array1LastPos: Integer;
Array2Pos, Array2FirstPos, Array2LastPos: Integer;
begin
Result := 0;
MinLength := 3;
MaxLength := Trunc( (High(Numbers) + 1 ) / 2 );
for Length := MinLength to MaxLength do
begin
SetLength(Array1, 0);
SetLength(Array2, 0);
SetLength(Array1, Length);
Array1FirstPos := 0;
Array1LastPos := High(Numbers) - High(Array1);
for Array1Pos := Array1FirstPos to Array1LastPos do
begin
for i := Array1Pos to Length + Array1Pos do
Array1[i - Array1Pos] := Numbers[i];
if ( High(Array2) + 1 <> Length ) then
SetLength(Array2, Length);
Array2FirstPos := Array1Pos + Length;
Array2LastPos := High(Numbers);
if ( ( Array1Pos >= Array2FirstPos ) and ( Array1Pos + Length <= Array2LastPos ) ) then
for Array2Pos := Array2FirstPos to Array2LastPos do
begin
for i := Array2Pos to Length + Array2Pos do
Array2[i - Array2Pos] := Numbers[i];
if CompareArrays(Array1, Array2) then
Result := Result + 1;
end;
end;
end;
SetLength(Array1, 0);
SetLength(Array2, 0);
end;
function TfrmMain.CompareArrays(Array1, Array2: Array of SmallInt): Boolean;
var
i: Integer;
begin
Result := false;
if ( High(Array1) <> High(Array2) ) then
Exit;
for i := 0 to High(Array1) do
if ( Array1[i] <> Array2[i] ) then
Exit;
Result := true;
end;
SOLVED! Thanks Jeferson Oliveira!
The error raising depends on the content of the arrays your are passing, so would be better if you could show us a calling example, or the content of your Memo.
Anyway, analyzing your code, I can see some things:
In the line below:
if ( High(Array2) + 1 <> Length ) then
SetLength(Array2, Length);
If Length = 0, or Length = High(Array2) + 1, the Array2 Length will not be defined.
Thus, when the code below is executed:
if ( ( Array1Pos >= Array2FirstPos ) and ( Array1Pos + Length <= Array2LastPos ) ) then
for Array2Pos := Array2FirstPos to Array2LastPos do
begin
for i := Array2Pos to Length + Array2Pos do
Array2[i - Array2Pos] := Numbers[i];
If the length of Array2 is not yet defined, you could have and AccessViolation.
So (for the only purpose of fix this code), you should test the length of Array2 before try to access its index, with:
for i := Array2Pos to Length + Array2Pos do
begin
if ((i - Array2Pos) >= System.Length(Array2) - 1) then
Array2[i - Array2Pos] := Numbers[i];
end;
But I believe that focusing on your logic and organizing some test values you will see that are a lot of improvement to be done to your code that will, themselves, solve the current AV.
Edited: as your variable has the same name of the global function "Length", I updated the sample code to use the "namespace" System.
Related
I would like to create an array and access it in the following way for read and write slice operations (i.e. more than one element at once):
If the indices are within range access them as usual
If the second index is smaller than the first index, access the data as follows:
First .. A'Last & A'First .. (First + 5) (turns out this doesn't work as-is due to concatenation result upper bound out of range)
I have come up with the following example to demonstrate the issue:
with Ada.Text_IO;
use Ada.Text_IO;
procedure Test_Modular is
type Idx is mod 10;
type My_Array is array (Idx range <>) of Integer;
A: My_Array(Idx) := (
0 => 0, 1 => 1, 2 => 2, 3 => 3, 4 => 4, 5 => 5,
6 => 6, 7 => 7, 8 => 8, 9 => 9
);
First: constant Idx := 7;
S: constant My_Array := A(First .. First + 5);
begin
for I in S'range loop
Put_Line(Idx'Image(I) & " --> " & Integer'Image(S(I)));
end loop;
end Test_Modular;
As in the example, the 5 is static, the compiler warns me as follows:
$ gnatmake -o test_modular test_modular.adb
x86_64-linux-gnu-gcc-10 -c test_modular.adb
test_modular.adb:18:19: warning: loop range is null, loop will not execute
x86_64-linux-gnu-gnatbind-10 -x test_modular.ali
x86_64-linux-gnu-gnatlink-10 test_modular.ali -o test_modular
When running the program, I observe the following:
$ ./test_modular
i.e. no output as predicted by the compiler warning.
Now I wonder: Is there a way to write the slice like A(First .. First + 5) and make it “wrap around” such that the data accessed will be the same as in this modified example program except without having to distinguish the two cases in the code explicitly?
with Ada.Text_IO;
use Ada.Text_IO;
procedure Test_Modular_2 is
type Idx is mod 10;
type My_Array is array (Idx range <>) of Integer;
A: My_Array(Idx) := (
0 => 0, 1 => 1, 2 => 2, 3 => 3, 4 => 4, 5 => 5,
6 => 6, 7 => 7, 8 => 8, 9 => 9
);
First: constant Idx := 7;
S1: constant My_Array := A(First .. A'Last);
S2: constant My_Array := A(A'First .. (First + 5));
begin
for I in S1'range loop
Put_Line(Idx'Image(I) & " --> " & Integer'Image(S1(I)));
end loop;
for I in S2'range loop
Put_Line(Idx'Image(I) & " --> " & Integer'Image(S2(I)));
end loop;
end Test_Modular_2;
Try the following approach:
with Ada.Text_IO; use Ada.Text_IO;
procedure Main is
type Idx is mod 10;
type My_Array is array (Idx range <>) of Integer;
function rotate (arr : My_Array; head : Idx; tail : Idx) return My_Array is
P1_Len : Natural;
P2_Len : Natural;
begin
P1_Len :=
(if head <= tail then Natural (tail) - Natural (head) + 1
else Natural (arr'Last) - Natural (head) + 1);
P2_Len := (if head <= tail then 0 else Natural (tail) + 1);
declare
Result : My_Array (0 .. Idx (P1_Len + P2_Len - 1));
begin
if head <= tail then
Result := arr (head .. tail);
else
Result (0 .. Idx (P1_Len - 1)) := arr (head .. arr'Last);
Result (Idx (P1_Len) .. Result'Last) := arr (0 .. tail);
end if;
return Result;
end;
end rotate;
procedure print (A : My_Array) is
begin
for V of A loop
Put (V'Image);
end loop;
New_Line;
end print;
A : My_Array :=
(0 => 0, 1 => 1, 2 => 2, 3 => 3, 4 => 4, 5 => 5, 6 => 6, 7 => 7, 8 => 8,
9 => 9);
head : Idx := 7;
tail : Idx := head + 5;
begin
Put_Line ("Head: " & head'Image & " Tail:" & tail'Image);
Put_Line ("Initial value order:");
print (A);
declare
S1 : My_Array := rotate (A, head, tail);
begin
Put_Line ("Rotated value order:");
print (S1);
end;
end Main;
The rotate function above rotates the set of values indicated by the head and tail index values, placing the head value at the start of the array returned by rotate. This example shows that the resulting array may contain fewer elements than the array passed as a parameter to the function.
Given that Idx is a modular type, an alternative approach is
function Rotate (Source : in My_Array; Start : in Idx; Stop : in Idx) return My_Array is
Last : Idx;
Next : Idx := Start;
Result : My_Array (Idx);
begin -- Rotate
Copy : for I in Result'range loop
Result (I) := Source (Next);
Last := I;
exit Copy when Next = Stop;
Next := Next + 1;
end loop Copy;
return Result (0 .. Last);
end Rotate;
A further alternative with explicit result-array bounds calculation could be:
function Get_Wrapped_Slice(A: in My_Array;
Start: in Idx;
Stop: in Idx) return My_Array is
Length: constant Idx := (if Stop >= Start then (Stop - Start) else (A'Last - Start + Stop + 1));
Result: My_Array( 0 .. Length);
Cursor: Idx := Start;
begin
for I of Result loop
I := A(Cursor);
Cursor := Cursor + 1;
end loop;
return Result;
end Get_Wrapped_Slice;
As you know in Excel column names are letters. When it reaches Z it continues with AA-AB-AC. Is it possible to make a similar function in Delphi XE7 + for loop?
I've tried:
var
i:integer;
str:string;
begin
str:='a';
for i := 0 to 26-1 do
begin
inc (str,1);
memo1.Lines.Add(str);
end;
but it returned:
[dcc32 Error] FBarkodsuzIndesignVerisiOlustur.pas(249): E2064 Left side cannot be assigned to
I assume that's because str is not an integer.
I can convert numbers to letters with this function:
function numberToString(number: Integer): String;
begin
Result := '';
if (number < 1) or (number > 26) then
Exit;
Result := 'abcdefghijklmnopqrstuvwxyz'[number];
end;
But I have no idea how we can create letters like AA when it exceeds 26.
Also with below approach, it creates 26 letters just fine but when it exceeds 26 it starts to use characters like brackets:
for i := 0 to 27-1 do
begin
memo1.Lines.Add(Char(Ord('a') + i));
end;
Output of it:
a
b
c
d
e
f
g
h
i
j
k
l
m
n
o
p
q
r
s
t
u
v
w
x
y
z
{
when it reach to Z it'll continue as "AA" "BB" "CC" and so on like Excel creates column names.
This is the function that I use for the task.
function SpreadSheetColName(const Col: Integer): string;
var
c: Char;
begin
Assert(Col >= 0);
if Col<26 then begin
c := 'A';
Inc(c, Col);
Result := c;
end else begin
Result := SpreadSheetColName(Col div 26 - 1) + SpreadSheetColName(Col mod 26);
end;
end;
Note that it uses zero based indices. I would suggest that you also use zero based indices as a general rule throughout your programming.
If you can't bring yourself to do that, then a one based version would look like this:
function SpreadSheetColName(const Col: Integer): string;
function SpreadSheetColNameZeroBased(const Col: Integer): string;
var
c: Char;
begin
Assert(Col >= 0);
if Col<26 then begin
c := 'A';
Inc(c, Col);
Result := c;
end else begin
Result := SpreadSheetColNameZeroBased(Col div 26 - 1) + SpreadSheetColNameZeroBased(Col mod 26);
end;
end;
begin
Result := SpreadSheetColNameZeroBased(Col - 1);
end;
program R3cord;
type rekord = record
end;
var i,d,j,c,x,y,a : integer;
mas : array[1..5] of rekord;
begin
x := 4;
y := 5;
for i := 1 to y do
Read(mas[i]);
for i := 1 to x do
begin
d := i;
for j := i + 1 to y do
if mas[j] > mas[d] then
d := j;
c := mas[i]; mas[i] := mas[d]; mas[d] := c;
end;
for i := 1 to 5 do
Write(mas[i],' ');
end.
I'm having a trouble here, as you can see this program will read user's input and will sort it in descending order. I need to have a row number near number which was before the sorting. I've read that record is good for it, but I can't find any tutorials how to do it.
First, your record doesn't have anything in it. I think you want:
type
rekord = record
value: Integer;
row: Integer;
end;
And when you read it in:
for i := 1 to 5 do
begin
Read(mas[i].value);
mas[i].row = i;
end
The above will number the rows 1, 2, 3, ...
And in your sort:
if mas[j].value > mas[d].value
When you swap, be sure to swap the whole record as you're currently doing. Don't just swap the values.
I have multiple arrays and they all start with integer fields, from 1 up to 5 fields, and these are like indexes that need to be sorted, from min to max:
TArrayA = record
Field1:integer;
Field2:integer;
Field3:integer;
Field4:integer;
Field5:integer;
... //other fields, strings, integers... up to 50 fields
end;
ArrayA:=array of TArrrayA;
Currently I use this approach to sort:
// sort by Field1
top:=Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if ArrayA[look].Field1 < ArrayA[min].Field1 then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
// now sort by Field2
top:=Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if (ArrayA[look].Field1 = ArrayA[min].Field1) And
(ArrayA[look].Field2 < ArrayA[min].Field2) then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
This does the job. Although is a bit slow when I need to sort all 5 fields,
and this is how I do it, field by field, so I sort the array 5 times. Is there any better, faster way?
Here is example:
procedure TForm1.Button8Click(Sender: TObject);
type
TArrayA = record
Field1: integer;
Field2: integer;
Field3: integer;
Field4: integer;
Field5: integer;
end;
var
ArrayA: array of TArrayA;
vTmpRecord: TArrayA;
top, counter, min, max, look: integer;
i,t1,t2:integer;
begin
SetLength(ArrayA,100000);
for i := 0 to 99999 do
begin
ArrayA[i].Field1:=1+Random(100);
ArrayA[i].Field2:=1+Random(100);
ArrayA[i].Field3:=1+Random(100);
ArrayA[i].Field4:=1+Random(100);
ArrayA[i].Field5:=1+Random(100);
end;
t1:=GetTickCount;
// sort by Field1
top := Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if ArrayA[look].Field1 < ArrayA[min].Field1 then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
// sort by Field2
top := Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if (ArrayA[look].Field1 = ArrayA[min].Field1) and
(ArrayA[look].Field2 < ArrayA[min].Field2) then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
// sort by Field3
top := Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if (ArrayA[look].Field1 = ArrayA[min].Field1) and (ArrayA[look].Field2 = ArrayA[min].Field2) and
(ArrayA[look].Field3 < ArrayA[min].Field3) then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
// sort by Field4
top := Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if (ArrayA[look].Field1 = ArrayA[min].Field1) and (ArrayA[look].Field2 = ArrayA[min].Field2) and (ArrayA[look].Field3 = ArrayA[min].Field3) and
(ArrayA[look].Field4 < ArrayA[min].Field4) then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
// sort by Field5
top := Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if (ArrayA[look].Field1 = ArrayA[min].Field1) and (ArrayA[look].Field2 = ArrayA[min].Field2) and (ArrayA[look].Field3 = ArrayA[min].Field3) and (ArrayA[look].Field4 = ArrayA[min].Field4) and
(ArrayA[look].Field5 < ArrayA[min].Field5) then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
t2:=GetTickCount;
Button8.Caption:=IntToStr(t2-t1);
end;
You can use built in Quick sort method for sorting arrays with your custom comparer:
uses
System.Math,
System.Generics.Defaults,
System.Generics.Collections;
TArray.Sort<TArrayA>(ArrayA, TComparer<TArrayA>.Construct( function(const Left, Right: TArrayA): Integer
begin
if Left.Field1 = Right.Field1 then
begin
if Left.Field2 = Right.Field2 then
begin
Result := CompareValue(Left.Field3, Right.Field3);
end
else Result := CompareValue(Left.Field2, Right.Field2);
end
else Result := CompareValue(Left.Field1, Right.Field1);
end
));
I added code only for first three fields, but you will get the picture how to build your own comparer for more fields.
The most important thing for you to do is to separate the sort algorithm from the data. That way you can write, or use, a single sort algorithm again and again with different data
The classic way to do that is to use a comparison sort. They are sort algorithms that require a compare function that compares two items and returns a negative integer for less than, a positive integer for greater than, and zero when equal.
So, let's start by demonstrating such a compare function for your data. Storing multiple fields as you have makes it hard to write a general purpose comparer. Better to put the fields in an array. Once you have done so you can do the compare lexicographically using iteration like this:
function CompareIntegerArray(const lhs, rhs: array of Integer): Integer;
var
i: Integer;
begin
Assert(Length(lhs) = Length(rhs));
for i := low(lhs) to high(lhs) do
if lhs[i] < rhs[i] then
exit(-1)
else if lhs[i] > rhs[i] then
exit(1);
exit(0);
end;
With a lexicographic order we first compare the primary field. If they differ we have our answer, otherwise we move on to the secondary field. And so on. Such an algorithm is well suited to iteration as demonstrated above.
This overcomes a significant weakness in your approach, by sorting the array once only.
Once you have this compare function you need to wrap it in an outer compare function that extracts data from the record fields and populates arrays. Perhaps along these lines:
type
TMyArray = array [1..5] of Integer;
function GetMyArray(const Value: TArrayA): TMyArray;
begin
Result[1] := Value.Field1;
Result[2] := Value.Field2;
....
end;
function MyCompare(const lhs, rhs: TArrayA): Integer;
begin
Result := CompareIntegerArray(
GetMyArray(lhs),
GetMyArray(rhs)
);
end;
Now, as promised, you can use this compare function with a general purpose sort like TArray.Sort<T> from Generics.Collections. This is an implementation of Quicksort, a comparison sort with average complexity of O(n log n). That will typically yield a huge benefit over your O(n2) bubble sort.
Life would be simpler if you could replace the record with an actual array. Another option that might be useful would be to add a method to the record that returned an array of integer ready for use in the lexicographic compare function.
To recap:
Separate data, comparison and sorting to facilitate re-use and clarity.
Use arrays to enable lexicographic compare to be implemented with a loop.
Use an efficient sort algorithm such as Quicksort.
Given a set {1,2,3,4,5...n} of n elements, we need to find all sets of disjoint pairs.
For example, if n=4, the output would be
{(1,2),(3,4)}, {(1,3),(2,4)}, {(1,4),(2,3)}
I am not even able to figure out how to start. I am hoping someone can give me a suggestion about which algorithm to use, and possibly some implementation details as well.
Edit:
Delphi code for recursive generation of (n-1)!! sets (1*3*5*7...n-1) from n=2*k elements
var
A: TArray<Integer>;
procedure Swap(i, j: integer);
var
t : integer;
begin
t := A[i];
A[i] := A[j];
A[j] := t;
end;
procedure MakePairs(Start: Integer; Pairs: string);
var
i: Integer;
begin
if Start >= Length(A) then
Writeln(Pairs)
else
for i := Start + 1 to High(A) do begin
Swap(Start + 1, i); //store used element in the array beginning
MakePairs(Start + 2, Pairs + Format('(%d,%d)', [A[Start], A[Start + 1]]));
Swap(Start + 1, i); //get it back
end;
end;
begin
A := TArray<Integer>.Create(1,2,3,4,5,6);
//be sure that array length is even!!!
MakePairs(0, '');
Writeln(PairCount);
Output:
(1,2)(3,4)(5,6)
(1,2)(3,5)(4,6)
(1,2)(3,6)(5,4)
(1,3)(2,4)(5,6)
(1,3)(2,5)(4,6)
(1,3)(2,6)(5,4)
(1,4)(3,2)(5,6)
(1,4)(3,5)(2,6)
(1,4)(3,6)(5,2)
(1,5)(3,4)(2,6)
(1,5)(3,2)(4,6)
(1,5)(3,6)(2,4)
(1,6)(3,4)(5,2)
(1,6)(3,5)(4,2)
(1,6)(3,2)(5,4)
15
Addition
Variant that works with odd-length array too (weird ordering)
procedure MakePairs(Start: Integer; Pairs: string);
var
i: Integer;
OddFlag: Integer;
begin
if Start >= Length(A) then
Memo1.Lines.Add(Pairs)
else begin
Oddflag := (High(A) - Start) and 1;
for i := Start + OddFlag to High(A) do begin
Swap(Start + OddFlag, i);
if OddFlag = 1 then
MakePairs(Start + 2, Pairs + Format('(%d,%d)', [A[Start], A[Start + 1]]))
else
MakePairs(Start + 1, Pairs);
Swap(Start + OddFlag, i);
end;
end;
end;
for (1,2,3,4,5):
(2,3)(4,5)
(2,4)(3,5)
(2,5)(4,3)
(1,3)(4,5)
(1,4)(3,5)
(1,5)(4,3)
(2,1)(4,5)
(2,4)(1,5)
(2,5)(4,1)
(2,3)(1,5)
(2,1)(3,5)
(2,5)(1,3)
(2,3)(4,1)
(2,4)(3,1)
(2,1)(4,3)
15
Not relevant now:
If every pair should occur just once (it is not clear from your example with n=4), then you can use round-robin tournament algorithm
n=4 case example here
You have to see the pattern here.
For {1, 2, 3, 4}.
Take the first element and make pairs with all the elements on the right.
(1, 2), (1, 3), (1, 4)
Take the second element and make pairs with all the elements on the right.
(2, 3), (2, 4)
Take the third element and make pairs with all the elements on the right.
(3, 4)
...and so on
Notice the pattern here.
You would need an outer loop to iterate over the elements and select each element one by one.
And another inner loop to iterate over the elements on the right of the selected element and make a pair with each one of them.