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;
Related
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].
I've been studying "Algorithms and Data Structures" by N.Wirth. He codes his algorithms in a language he created: Oberon. I finished the book but I have one doubt about this algorithim of page 19 coded in Oberon:
PROCEDURE Power (VAR W: Texts.Writer; N: INTEGER);
VAR i, k, r: INTEGER;
d: ARRAY N OF INTEGER;
BEGIN
FOR k := 0 TO N-1 DO
Texts.Write(W, "."); r := 0;
FOR i := 0 TO k-1 DO
r := 10*r + d[i]; d[i] := r DIV 2; r := r MOD 2;
Texts.Write(W, CHR(d[i] + ORD("0")))
END;
d[k] := 5; Texts.Write(W, "5"); Texts.WriteLn(W)
END
END Power
The resulting output text for N = 10 is
.5
.25
.125
.0625
.03125
.015625
.0078125
.00390625
.001953125
.0009765625
I don´t understand what the instructions in line 10 d[k] := 5; Texts.Write(W, "5"); Texts.WriteLn(W) does:
1) Why you would you d[k] := 5? the program already printed all the output required (d[0] to d[k-1]).
2) why would you print a 5 after that? (Texts.Write(W, "5"))
The computation utilizes the fact that the last digit will always be five.
Unless the execution has finished, the variable d[k] is read in the next turn of the outer loop when r becomes 10*r + d[i] in the last turn of the inner loop
The statement Texts.Write(W, "5") requires (marginally) less computation than Texts.Write(W, d[i]).
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 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;
To find the intersection of N arrays I have this implementation, which is horribly inefficient. I know there has to be an algorithm out there to speed this up.
note: myarray is the array containing all my other arrays for which I want to find the intersection for.
var
i, j, k: integer;
myarray: Array of Array of integer;
intersection: array of integer;
for I := 0 to length(myarray)-1 do
begin
for J := 0 to length(myarray)-1 do
begin
if i = j then
continue;
for k := 0 to length(myarray[i])-1 do
begin
if myarray[i][j] = myarray[j][k] then
begin
setLength(intersection, length(intersection)+1);
intersection[length(intersection)-1] := myarray[j][k];
end;
end;
end;
end;
What optimization can I apply to speed this up? Is there a faster way of doing this?
EDIT: Data in arrays are unsorted.
There is a faster way: the list comparison algorithm. It allows you to compare two lists in linear time instead of quadratic time. Here's the basic idea:
Sort both lists by the same criteria. (Make copies of the lists first, if you need to preserve the original ordering.)
Start at the top of both lists. Pick the first item from each and compare them.
If they match, handle the case and advance the index for both lists.
If they don’t match, loop through, advancing the index for the list with the “lesser” value each time, until a match is found.
When you reach the end of either list, you’re done. (Unless you want to handle any leftovers from the other list.)
This can be extended to deal with more than 2 lists with a bit of effort.
Unfortunately, you have not updated your question yet, so it still is not exactly clear what you are asking. E.g. you talk about an intersection (which should search for values that exist in every single array), but from the (not working) code it seems you are simply searching for duplicates in any of the arrays.
Although Mason's answer points to an obvious general solution for these kind of algorithms, I believe it is somewhat different for such a multi-dimensional array. I worked out two routines for determination of (1) the intersection as well as (2) the duplicates. Both assume unordered content of unequal length in the arrays.
First, I decided to introduce some new types:
type
PChain = ^TChain;
TChain = array of Integer;
TChains = array of TChain;
Secondly, both routines need some sorting mechanism. A very quick but dirty one is done by employing/misusing a TList:
function CompareInteger(Item1, Item2: Pointer): Integer;
begin
Result := Integer(Item1) - Integer(Item2);
end;
procedure SortChain(var Chain: TChain);
var
List: TList;
begin
List := TList.Create;
try
List.Count := Length(Chain);
Move(Chain[0], List.List[0], List.Count * SizeOf(Integer));
List.Sort(CompareInteger);
Move(List.List[0], Chain[0], List.Count * SizeOf(Integer));
finally
List.Free;
end;
end;
But a much nicer implementation is gotten by adjusting the RTL code from Classes.QuickSort, which does exactly the same as the one above, without copying the array (twice):
procedure SortChain(Chain: PChain; L, R: Integer);
var
I: Integer;
J: Integer;
Value: Integer;
Temp: Integer;
begin
repeat
I := L;
J := R;
Value := Chain^[(L + R) shr 1];
repeat
while Chain^[I] < Value do
Inc(I);
while Chain^[J] > Value do
Dec(J);
if I <= J then
begin
Temp := Chain^[I];
Chain^[I] := Chain^[J];
Chain^[J] := Temp;
Inc(I);
Dec(J);
end;
until I > J;
if L < J then
SortChain(Chain, L, J);
L := I;
until I >= R;
end;
Intersection:
To obtain the intersection of all arrays, comparing all values in the shortest array with the values in all other arrays is enough. Because the shortest array may contain duplicate values, that small array is sorted in order to be able to ignore the duplicates. From that point it is simply a matter of finding (or rather nót finding) a same value in one of the other arrays. Sorting all other arrays is not necessary, because the chance to find a value at an earlier position than within a sorted array is 50%.
function GetChainsIntersection(const Chains: TChains): TChain;
var
IShortest: Integer;
I: Integer;
J: Integer;
K: Integer;
Value: Integer;
Found: Boolean;
FindCount: Integer;
begin
// Determine which of the chains is the shortest
IShortest := 0;
for I := 1 to Length(Chains) - 1 do
if Length(Chains[I]) < Length(Chains[IShortest]) then
IShortest := I;
// The length of result will at maximum be the length of the shortest chain
SetLength(Result, Length(Chains[IShortest]));
Value := 0;
FindCount := 0;
// Find for every value in the shortest chain...
SortChain(#Chains[IShortest], 0, Length(Chains[IShortest]) - 1);
for K := 0 to Length(Chains[IShortest]) - 1 do
begin
if (K > 0) and (Chains[IShortest, K] = Value) then
Continue;
Value := Chains[IShortest, K];
Found := False;
for I := 0 to Length(Chains) - 1 do
if I <> IShortest then
begin
Found := False;
for J := 0 to Length(Chains[I]) - 1 do
// ... the same value in other chains
if Chains[I, J] = Value then
begin
Found := True;
Break;
end;
if not Found then
Break;
end;
// Add a found value to the result
if Found then
begin
Result[FindCount] := Value;
Inc(FindCount);
end;
end;
// Truncate the length of result to the actual number of found values
SetLength(Result, FindCount);
end;
Duplicates:
This also does not require sorting all arrays individually. All values are copied into a one-dimensional temporary array. After sorting thát array, it is easy to find the duplicates.
function GetDuplicateShackles(const Chains: TChains): TChain;
var
Count: Integer;
I: Integer;
Temp: TChain;
PrevValue: Integer;
begin
// Foresee no result
SetLength(Result, 0);
// Count the total number of values
Count := 0;
for I := 0 to Length(Chains) - 1 do
Inc(Count, Length(Chains[I]));
if Count > 0 then
begin
// Copy all values to a temporary chain...
SetLength(Temp, Count);
Count := 0;
for I := 0 to Length(Chains) - 1 do
begin
Move(Chains[I][0], Temp[Count], Length(Chains[I]) * SizeOf(Integer));
Inc(Count, Length(Chains[I]));
end;
// Sort the temporary chain
SortChain(#Temp, 0, Count - 1);
// Find all duplicate values in the temporary chain
SetLength(Result, Count);
Count := 0;
PrevValue := Temp[0];
for I := 1 to Length(Temp) - 1 do
begin
if (Temp[I] = PrevValue) and
((Count = 0) or (Temp[I] <> Result[Count - 1])) then
begin
Result[Count] := PrevValue;
Inc(Count);
end;
PrevValue := Temp[I];
end;
SetLength(Result, Count);
end;
end;
Sample application:
And because I like to test all my code, it needed very little work to make it somewhat representative.
unit Unit1;
interface
uses
SysUtils, Classes, Controls, Forms, StdCtrls, Grids;
type
PChain = ^TChain;
TChain = array of Integer;
TChains = array of TChain;
TForm1 = class(TForm)
Grid: TStringGrid;
IntersectionFullButton: TButton;
IntersectionPartialButton: TButton;
DuplicatesFullButton: TButton;
DuplicatesPartialButton: TButton;
Memo: TMemo;
procedure FormCreate(Sender: TObject);
procedure IntersectionButtonClick(Sender: TObject);
procedure DuplicatesButtonClick(Sender: TObject);
private
procedure ClearGrid;
procedure ShowChains(const Chains: TChains);
procedure ShowChain(const Chain: TChain; const Title: String);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const
MaxDepth = 20;
procedure FillChains(var Chains: TChains; FillUp: Boolean; MaxValue: Integer);
var
X: Integer;
Y: Integer;
Depth: Integer;
begin
SetLength(Chains, MaxDepth);
for X := 0 to MaxDepth - 1 do
begin
if FillUp then
Depth := MaxDepth
else
Depth := Random(MaxDepth - 2) + 3; // Minimum depth = 3
SetLength(Chains[X], Depth);
for Y := 0 to Depth - 1 do
Chains[X, Y] := Random(MaxValue);
end;
end;
procedure SortChain(Chain: PChain; L, R: Integer);
var
I: Integer;
J: Integer;
Value: Integer;
Temp: Integer;
begin
repeat
I := L;
J := R;
Value := Chain^[(L + R) shr 1];
repeat
while Chain^[I] < Value do
Inc(I);
while Chain^[J] > Value do
Dec(J);
if I <= J then
begin
Temp := Chain^[I];
Chain^[I] := Chain^[J];
Chain^[J] := Temp;
Inc(I);
Dec(J);
end;
until I > J;
if L < J then
SortChain(Chain, L, J);
L := I;
until I >= R;
end;
function GetChainsIntersection(const Chains: TChains): TChain;
var
IShortest: Integer;
I: Integer;
J: Integer;
K: Integer;
Value: Integer;
Found: Boolean;
FindCount: Integer;
begin
IShortest := 0;
for I := 1 to Length(Chains) - 1 do
if Length(Chains[I]) < Length(Chains[IShortest]) then
IShortest := I;
SetLength(Result, Length(Chains[IShortest]));
Value := 0;
FindCount := 0;
SortChain(#Chains[IShortest], 0, Length(Chains[IShortest]) - 1);
for K := 0 to Length(Chains[IShortest]) - 1 do
begin
if (K > 0) and (Chains[IShortest, K] = Value) then
Continue;
Value := Chains[IShortest, K];
Found := False;
for I := 0 to Length(Chains) - 1 do
if I <> IShortest then
begin
Found := False;
for J := 0 to Length(Chains[I]) - 1 do
if Chains[I, J] = Value then
begin
Found := True;
Break;
end;
if not Found then
Break;
end;
if Found then
begin
Result[FindCount] := Value;
Inc(FindCount);
end;
end;
SetLength(Result, FindCount);
end;
function GetDuplicateShackles(const Chains: TChains): TChain;
var
Count: Integer;
I: Integer;
Temp: TChain;
PrevValue: Integer;
begin
SetLength(Result, 0);
Count := 0;
for I := 0 to Length(Chains) - 1 do
Inc(Count, Length(Chains[I]));
if Count > 0 then
begin
SetLength(Temp, Count);
Count := 0;
for I := 0 to Length(Chains) - 1 do
begin
Move(Chains[I][0], Temp[Count], Length(Chains[I]) * SizeOf(Integer));
Inc(Count, Length(Chains[I]));
end;
SortChain(#Temp, 0, Count - 1);
SetLength(Result, Count);
Count := 0;
PrevValue := Temp[0];
for I := 1 to Length(Temp) - 1 do
begin
if (Temp[I] = PrevValue) and
((Count = 0) or (Temp[I] <> Result[Count - 1])) then
begin
Result[Count] := PrevValue;
Inc(Count);
end;
PrevValue := Temp[I];
end;
SetLength(Result, Count);
end;
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
Grid.ColCount := MaxDepth;
Grid.RowCount := MaxDepth;
end;
procedure TForm1.ClearGrid;
var
I: Integer;
begin
for I := 0 to Grid.ColCount - 1 do
Grid.Cols[I].Text := '';
end;
procedure TForm1.ShowChains(const Chains: TChains);
var
I: Integer;
J: Integer;
begin
for I := 0 to Length(Chains) - 1 do
for J := 0 to Length(Chains[I]) - 1 do
Grid.Cells[I, J] := IntToStr(Chains[I, J]);
end;
procedure TForm1.ShowChain(const Chain: TChain; const Title: String);
var
I: Integer;
begin
if Length(Chain) = 0 then
Memo.Lines.Add('No ' + Title)
else
begin
Memo.Lines.Add(Title + ':');
for I := 0 to Length(Chain) - 1 do
Memo.Lines.Add(IntToStr(Chain[I]));
end;
end;
procedure TForm1.IntersectionButtonClick(Sender: TObject);
var
FillUp: Boolean;
Chains: TChains;
Chain: TChain;
begin
ClearGrid;
Memo.Clear;
FillUp := Sender = IntersectionFullButton;
if FillUp then
FillChains(Chains, True, 8)
else
FillChains(Chains, False, 4);
ShowChains(Chains);
Chain := GetChainsIntersection(Chains);
ShowChain(Chain, 'Intersection');
end;
procedure TForm1.DuplicatesButtonClick(Sender: TObject);
var
Chains: TChains;
Chain: TChain;
begin
ClearGrid;
Memo.Clear;
FillChains(Chains, Sender = DuplicatesFullButton, 900);
ShowChains(Chains);
Chain := GetDuplicateShackles(Chains);
ShowChain(Chain, 'Duplicates');
end;
initialization
Randomize;
end.
Unit1.DFM:
object Form1: TForm1
Left = 343
Top = 429
Width = 822
Height = 459
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
DesignSize = (
806
423)
PixelsPerInch = 96
TextHeight = 13
object Memo: TMemo
Left = 511
Top = 63
Width = 295
Height = 360
Anchors = [akLeft, akTop, akRight, akBottom]
ScrollBars = ssVertical
TabOrder = 5
end
object IntersectionFullButton: TButton
Left = 511
Top = 7
Width = 141
Height = 25
Caption = 'Intersection (full chains)'
TabOrder = 1
OnClick = IntersectionButtonClick
end
object Grid: TStringGrid
Left = 0
Top = 0
Width = 503
Height = 423
Align = alLeft
ColCount = 20
DefaultColWidth = 24
DefaultRowHeight = 20
FixedCols = 0
RowCount = 20
FixedRows = 0
TabOrder = 0
end
object DuplicatesFullButton: TButton
Left = 658
Top = 7
Width = 141
Height = 25
Caption = 'Duplicates (full chains)'
TabOrder = 3
OnClick = DuplicatesButtonClick
end
object IntersectionPartialButton: TButton
Left = 511
Top = 35
Width = 141
Height = 25
Caption = 'Intersection (partial chains)'
TabOrder = 2
OnClick = IntersectionButtonClick
end
object DuplicatesPartialButton: TButton
Left = 658
Top = 35
Width = 141
Height = 25
Caption = 'Duplicates (partial chains)'
TabOrder = 4
OnClick = DuplicatesButtonClick
end
end
if myarray[i][j] = myarray[j][k] then
Shouldn't that be
if myarray[i][k] = myarray[j][k] then
?
Anyway, the most obvious, simple optimization you can make to this code is changing this
for I := 0 to length(myarray)-1 do
begin
for J := 0 to length(myarray)-1 do
begin
if i = j then
continue;
into this
for I := 0 to length(myarray)-1 do
begin
for J := I+1 to length(myarray)-1 do
begin
My next step would be to get rid of the outer index expressions in the inner loop:
if myarray[i][j] = myarray[j][k] then
In the I and J loops, create pointers to two arrays of integers, then do
for I := 0 to length(myarray)-1 do
begin
pia := #myarray[i];
for J := I+1 to length(myarray)-1 do
begin
pja := #myarray[j];
Then in the inner loop you can do
if pia^[j] = pja^[k] then