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.
Related
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;
procedure TfrmMain.createpnl(i: integer);
var
j,c: integer;
begin
c:=5;
top := pnlResult1.top;
for j := 1 TO i do
if (arrFound[j] <> -1) or (arrFound[j] <> 0) then
begin
with dmAll do
begin
tblHouses.First;
while not tblHouses.Eof do
begin
if tblHouses['ID'] = arrFound[j] then
begin
if j > 1 then
itop := j * pnlResult1.top + (j - 1) * pnlResult1.Height;
SetLength(arrpnl, c);
SetLength(arrimg, c);
SetLength(arrlbl[1], c);
SetLength(arrlbl[2], c);
SetLength(arrlbl[3], c);
SetLength(arrlbl[4], c);
SetLength(arrlbl[5], c);
SetLength(arrlbl[6], c);
{ the violation usually happes at arrlbl[6] but it has been in the neighboring area before }
/// ///////////dupe panels
arrpnl[c] := TPanel.Create(frmMain);
with arrpnl[c] do
begin
Parent := scbMain;
Width := pnlResult1.Width;
Height := pnlResult1.Height;
left := pnlResult1.left;
top := itop;
Visible := true;
Color := pnlResult1.Color;
end;
frmMain.Position:=poScreenCenter;
/// //////////dupe photos
arrimg[c] := TImage.Create(frmMain);
with arrimg[c] do
begin
Parent := arrpnl[c];
Width := Image1.Width;
Height := Image1.Height;
left := Image1.left;
top := Image1.top;
end;
{ i cut some spaghetti code to shorten question }
tblPhotos.First;
while NOT tblPhotos.Eof do
begin
if tblPhotos['HouseID'] = tblHouses['ID'] then
if fileexists(tblPhotos['photo']) then
begin
arrimg[c].Picture.LoadFromFile(tblPhotos['photo']);
arrimg[c].Stretch := true;
end
else
begin
if fileexists('H:\v0.1\not-found-image-15383864787lu.jpg') then
begin
arrimg[c].Picture.LoadFromFile
('H:\v0.1\not-found-image-15383864787lu.jpg');
arrimg[c].Stretch := true;
end;
end;
tblPhotos.Next
end;
tblOwners.First;
while NOT tblOwners.Eof do
begin
if tblOwners['ID'] = tblHouses['hOwner'] then
begin
arrlbl[4][c].caption := 'Email: ' + tblOwners['oEmail'] + #10 +
'Cell number: ' + tblOwners['oCell'];
end;
tblOwners.Next;
end;
inc(c);
bFound := true;
end;
tblHouses.Next;
end;
end;
end;
end;
I search through a database to find guesthouses that match the search criteria in an above procedure.
The search returns an array (arrFound) filled with ID's of houses that match search criteria.
I then make all duplicate results -1 and create TPanels dynamically to return the guesthouses as browseable results in a TScrollBox.
The dynamic array in question (arrlbl) is a 2D array of TLabels with a predetermined first value and a dynamic second value (depending on the amount of results).
I used 1D arrays but that gave the same error and I have a similar procedure on another form that doesn't give any errors.
It seems like you got the indices wrong.
In general, a dynamic array with n elements has indices 0..n - 1.
For example, if a is a dynamic array with 5 elements, the elements are a[0], a[1], a[2], a[3], and a[4]. There is no a[5].
type
mas = array [1 .. 10000] of real;
var
n: integer;
a: mas;
Rf: text;
Procedure Skaityti;
var
i: integer;
Df: text;
begin
Assign(Df, 'duom1.txt');
Reset(Df);
Readln(Df, n);
for i := 1 to n do
Read(Df, a[i]);
Close(Df);
end;
Procedure MinMax(var min, max, nrmin, nrmax, vid: real);
var
i: integer;
begin
min := a[1];
max := a[1];
nrmin := 1;
nrmax := 1;
for i := 1 to n do
begin
if min > a[i] then
begin
min := a[i];
nrmin := i;
end;
if max < a[i] then
begin
max := a[i];
nrmax := i;
end;
vid := vid + a[i];
end;
vid := vid / n;
end;
var
min, max, nrmin, nrmax, vid: real;
begin
Skaityti;
MinMax(min, max, nrmin, nrmax, vid);
Assign(Rf, 'rez.txt');
Rewrite(Rf);
WriteLn(Rf, 'biggest amount ', max:7:2, ' number ', nrmax:7:0);
WriteLn(Rf, 'smallest amount ', min:7:2, ' number', nrmin:7:0);
WriteLn(Rf, 'average amount ', vid:7:2);
WriteLn(Rf);
WriteLn(Rf, 'number amount');
Close(Rf);
end.
This is the code and it Reads elements from a .txt file to an array, I created procedure to find biggest and smallest value of it. Now I need to create a procedure to write my array from biggest to smallest and a row number next to it. It should look something like this:
Row number value
5 1000000
6 999999
8 888888
and so on.. Any ideas ?
P.S. I can arrange that array to be from biggest to smallest but then the row numbers will mess up :/
Create a record type with two fields, one for the value from the file and the other for the "row" number.
Change the array to be an array of that record type.
When reading the file in the for loop, assign the read value to the value field of the record and the for loop control variable value as the "row" number.
When you sort the array, you sort the records, thus keeping value and row together.
I need to remove all duplicate values from an array of integer, yet maintain the order of the elements:
Example:
10,20,20(duplicate),10(duplicate),50
Becomes:
10,20,50
Create a dictionary with Integer as the key. The value type is immaterial.
Iterate through the input array. For each value in the input array, check whether or not that value is in the dictionary.
If yes, this is a duplicate, discard.
If no, this is the first time the value has been encountered. Retain the value, and add it to the dictionary.
The point of the dictionary is that it can perform O(1) lookup.
In pseudocode:
var
arr: TArray<Integer>; // input and output
Dict: TDictionary<Integer, Integer>;
SrcIndex, DestIndex: Integer;
....
DestIndex := 0;
for SrcIndex := 0 to high(arr) do begin
Value := arr[SrcIndex];
if not Dict.ContainsKey(Value) then begin
arr[DestIndex] := arr[SrcIndex];
Dict.Add(Value, 0);
inc(DestIndex);
end;
end;
SetLength(arr, DestIndex);
Obviously you need to create, and destroy, the dictionary. I'm assuming you know how to do that. And I've opted to modify the array in place but you could equally create a new array if you prefer.
heres a version without dictionary.
procedure TForm1.RemoveDuplicates;
var
i,j,k,tot,mov:integer;
arr:array of integer;
begin
arr := [10,20,30,40,30,20,10,10,50,10,20,40];
tot := 0;
for i := 0 to length(arr)-1 do
begin
if i >= length(arr)-tot-1 then
break;
for j := i + 1 to length(arr)-1-tot do
begin
if j >= length(arr)-tot-1 then
break;
mov := 0;
while arr[i] = arr[j] do
begin
inc(mov);
arr[j] := arr[j+mov];
end;
tot := tot + mov;
if mov>0 then
for k := j+1 to length(arr)-1-tot do
arr[k] := arr[k+mov];
end;
end;
SetLength(arr,length(arr)-tot-1);
end;
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.