I need to implement Seidel method in Pascal. I tried this code but it gives the wrong answer. I don't understand what the mistake is. This is what the procedure for finding roots looks like:
procedure Seidel(n: Integer; var x: vector; a: matrix; e: Real);
var k, i, j, z: integer;
s: Real;
begin
for k := 1 to 100 do
begin
z := k;
for i := 1 to n do
begin
s := a[i, n + 1];
for j := 1 to n do s := s - a[i, j] * x[j];
s := s / a[i, i];
x[i] := x[i] + s;
if abs(s) > e then z := 0
end;
if z <> 0 then Break;
end;
end;
Procedure for variable 'a'
procedure ReadA;
var i, j: integer;
begin
for i := 1 to m do
for j := 1 to m + 1 do
a[i, j] := StrToFloat(Form1.StringGrid1.Cells[j, i])
end;
This is how StringGrid looks like:
"Корни Х" - "Roots X"
When you click on the "Расчёт" (calculate) button, the answers are different, and after repeated clicking, the "Floating point overflow" error appears.
The mistakes are
using no comments
using more than 2 single-letter variable names
using anti-patterns: a counting loop (for loop) should be used only if you can predict the exact number of iterations. Break does/should not belong to your standard repertoire, I even consider it a variant of spaghetti code. There are very few exceptions to this rule, but here you it’s better to stick to using a conditional loop (while … do or repeat … until).
omitting begin … end frames (for branches and loops) during development, when your program evidently is not finished yet
To be fair, the Seidel method can be confusing. On the other hand, Pascal is, provided a sufficient language proficiency, pretty well-suited for such a task.
I actually had to program that task myself in order to possibly understand why your procedure does not produce the right result. The following program uses some Extended Pascal (ISO 10206) features like schemata and type inquiries. You will need an EP-compliant compiler for that, such as the GPC (GNU Pascal Compiler). AFAIK, Delphi does not support those features, but it should be an easy task to resolve any deficiencies.
Considering all aforementioned “mistakes” you arrive at the following solution.
program seidel(output);
type
naturalNumber = 1..maxInt value 1;
All naturalNumber values below are initialized with 1 unless otherwise specified. This is an EP extension.
linearSystem(
coefficientCount: naturalNumber;
equationCount: naturalNumber
) = record
coefficient: array[1..equationCount, 1..coefficientCount] of real;
result: array[1..coefficientCount] of real;
solution: array[1..equationCount] of real;
end;
Of course you may structure that data type differently depending on your main usage scenario.
{
Approximates the solution of the passed linearSystem
using the Gauss-Seidel method.
system.solution should contain an estimate of the/a solution.
}
procedure approximateSolution(var system: linearSystem);
{ Returns `true` if any element along the main diagonal is zero. }
{ NB: There is a chance of false negatives. }
function mainDiagonalNonZero: Boolean;
var
product: real value 1.0;
n: naturalNumber;
begin
{ Take the product of all elements along the main diagonal. }
{ If any element is zero, the entire product is zero. }
for n := 1 to system.coefficientCount do
begin
product := product * system.coefficient[n, n];
end;
mainDiagonalNonZero := product <> 0.0;
end;
This function mainDiagonalNonZero serves as a reminder that you can “nest” routines in routines. Although it is only called once below, it cleans up your source code a bit if you structure units of code like that.
type
{ This is more readable than using plain integer values. }
relativeOrder = (previous, next);
var
approximation: array[relativeOrder] of type of system.solution;
Note, that approximation is declared in front of getNextApproximationResidual, so both this function and the main block of approximateSolution can access the same vectors.
{ Calculates the next approximation vector. }
function getNextApproximationResidual: real;
var
{ used for both, identifying the equation and a coefficient }
n: naturalNumber;
{ used for identifying one term, i.e. coefficient × solution }
term: 0..maxInt;
{ denotes a current error of this new/next approximation }
residual: real;
{ denotes the largest error }
residualMaximum: real value 0.0;
{ for simplicity, you could use `approximation[next, n]` instead }
sum: real;
begin
for n := 1 to system.equationCount do
begin
sum := 0.0;
for term := 1 to n - 1 do
begin
sum := sum + system.coefficient[n, term] * approximation[next, term];
end;
{ term = n is skipped, because that's what we're calculating }
for term := n + 1 to system.equationCount do
begin
sum := sum + system.coefficient[n, term] * approximation[previous, term];
end;
Here it becomes apparent, that your implementation does not contain two for loops. It does not iterate over all terms.
sum := system.result[n] - sum;
{ everything times the reciprocal of coefficient[n, n] }
approximation[next, n] := sum / system.coefficient[n, n];
{ finally, check for larger error }
residual := abs(approximation[next, n] - approximation[previous, n]);
if residual > residualMaximum then
begin
residualMaximum := residual;
end;
end;
getNextApproximationResidual := residualMaximum;
end;
I have outsourced this function getNextApproximationResidual so I could write a nicer abort condition in the loop below.
const
{ Perform at most this many approximations before giving up. }
limit = 1337;
{ If the approximation improved less than this value, }
{ we consider the approximation satisfactory enough. }
errorThreshold = 8 * epsReal;
var
iteration: naturalNumber;
begin
if system.coefficientCount <> system.equationCount then
begin
writeLn('Error: Gauss-Seidel method only works ',
'on a _square_ system of linear equations.');
halt;
end;
{ Values in the main diagonal later appear as divisors, }
{ that means they must be non-zero. }
if not mainDiagonalNonZero then
begin
writeLn('Error: supplied linear system contains ',
'at least one zero along main diagonal.');
halt;
end;
Do not trust user input. Before we calculate anything, ensure the system meets some basic requirements. halt (without any parameters) is an EP extension. Some compilers’ halt also accept an integer parameter to communicate the error condition to the OS.
{ Take system.solution as a first approximation. }
approximation[next] := system.solution;
repeat
begin
iteration := iteration + 1;
{ approximation[next] is overwritten by `getNextApproximationError` }
approximation[previous] := approximation[next];
end
until (getNextApproximationResidual < errorThreshold) or_else (iteration >= limit);
The or_else operator is an EP extension. It explicitly denotes “lazy/short-cut evaluation”. Here it wasn’t necessary, but I like it nevertheless.
{ Emit a warning if the previous loop terminated }
{ because of reaching the maximum number of iterations. }
if iteration >= limit then
begin
writeLn('Note: Maximum number of iterations reached. ',
'Approximation may be significantly off, ',
'or it does not converge.');
end;
{ Finally copy back our best approximation. }
system.solution := approximation[next];
end;
I used the following for testing purposes. protected (EP) corresponds to const in Delphi (I guess).
{ Suitable for printing a small linear system. }
procedure print(protected system: linearSystem);
const
totalWidth = 8;
fractionWidth = 3;
times = ' × ';
plus = ' + ';
var
equation, term: naturalNumber;
begin
for equation := 1 to system.equationCount do
begin
write(system.coefficient[equation, 1]:totalWidth:fractionWidth,
times,
system.solution[1]:totalWidth:fractionWidth);
for term := 2 to system.coefficientCount do
begin
write(plus,
system.coefficient[equation, term]:totalWidth:fractionWidth,
times,
system.solution[term]:totalWidth:fractionWidth);
end;
writeLn('⩰ ':8, system.result[equation]:totalWidth:fractionWidth);
end;
end;
The following example system of linear equations was taken from Wikipedia, so I “knew” the correct result:
{ === MAIN ============================================================= }
var
example: linearSystem(2, 2);
begin
with example do
begin
{ first equation }
coefficient[1, 1] := 16.0;
coefficient[1, 2] := 3.0;
result[1] := 11.0;
{ second equation }
coefficient[2, 1] := 7.0;
coefficient[2, 2] := -11.0;
result[2] := 13.0;
{ used as an estimate }
solution[1] := 1.0;
solution[2] := 1.0;
end;
approximateSolution(example);
print(example);
end.
Related
So I've come up with the code to the values of the triangle itself. What I'm currently strugling is how to aligne/center the values that are printed. I tried many things but, I could use some help now. If anyone has an idea how this can be done feel free to share! Thank you
Program Tri_pas;
Uses Crt;
Var
linha,ordem,a,b: byte;
Function fat(X: byte): real; // factorial
Var fat1: real;
Begin
fat1:=1;
If X <= 1 Then
fat:=1
Else
Begin
Repeat
fat1:=(fat1 * X);
X:=(X - 1);
Until X <= 1;
fat:=fat1;
End;
End;
Procedure nCp(n,p: byte); //Combinations
Var
i: byte;
nCp: real;
Begin
If n < 1 Then
n:=0
Else
n:=(n-1);
For i:=0 to n do
Begin
writeln;
For p:=0 to i do
Begin
nCp:= fat(i) / (fat(p) * fat(i - p)); // mathematic formula for the combinations
Write(nCp:1:0,' ');
End;
End;
End;
{ Main Programa }
Begin
Write('Insert a line(1 -> n) : ');
Readln(linha);
nCp(linha,ordem);
readln;
End.
Just add appropriate number of empty spaces before strings. Note that I used double-spaces, and changed placeholder size to 4 (3+1) to make better formatting.
For p := 1 to (n - i) do
Write(' ');
For p:=0 to i do
Begin
nCp:= fat(i) / (fat(p) * fat(i - p)); // mathematic formula for the combinations
Write(nCp:3:0,' ');
End;
P.S. There are more effective ways to calculate Ncr in reasonable range without real numbers.
I have a time problem with my program. Given a set of points, it has to say whether all of those points are lying on two different lines.
I wrote code, which has points in array and removes one by one and try calculate it's vector.
But this solution is slow, because it must control all cases of lines. On input with 10,000 points it takes over 10 seconds.
Can someone please tell me if, is here better solution for this problem?
I made this code in Pascal:
uses
math;
type
TPoint = record
x, y: real;
end;
TList = array of TPoint;
function xround(value: real; places: integer): real;
var
muldiv: real;
begin
muldiv := power(10, places);
xround := round(value * muldiv) / muldiv;
end;
function samevec(A, B, C: TPoint): boolean;
var
bx, by: real; // vec A -> B
cx, cy: real; // vec A -> C
lb, lc: real; // len AB, len AC
begin
bx := B.x - A.x;
by := B.y - A.y;
cx := C.x - A.x;
cy := C.y - A.y;
lb := sqrt(bx * bx + by * by);
lc := sqrt(cx * cx + cy * cy);
// normalize
bx := xround(bx / lb, 3);
by := xround(by / lb, 3);
cx := xround(cx / lc, 3);
cy := xround(cy / lc, 3);
samevec := ((bx = cx) and (by = cy)) or ((bx = -cx) and (by = -cy));
end;
function remove(var list: TList; idx: integer): TPoint;
var
i: integer;
begin
remove.x := 0;
remove.y := 0;
if idx < length(list) then
begin
remove := list[idx];
for i := idx to length(list) - 2 do
list[i] := list[i + 1];
setlength(list, length(list) - 1);
end;
end;
var
i, j, lines: integer;
list, work: TList;
A, B: TPoint;
begin
while not eof(input) do
begin
setlength(list, length(list) + 1);
with list[length(list) - 1] do
readln(x, y);
end;
if length(list) < 3 then
begin
writeln('ne');
exit;
end;
lines := 0;
for i := 1 to length(list) - 1 do
begin
work := copy(list, 0, length(list));
lines := 1;
B := remove(work, i);
A := remove(work, 0);
for j := length(work) - 1 downto 0 do
if samevec(A, B, work[j]) then
remove(work, j);
if length(work) = 0 then
break;
lines := 2;
A := remove(work, 0);
B := remove(work, 0);
for j := length(work) - 1 downto 0 do
if samevec(A, B, work[j]) then
remove(work, j);
if length(work) = 0 then
break;
lines := 3; // or more
end;
if lines = 2 then
writeln('YES')
else
writeln('NO');
end.
Thanks, Ferko
APPENDED:
program line;
{$APPTYPE CONSOLE}
uses
math,
sysutils;
type point=record
x,y:longint;
end;
label x;
var
Points,otherPoints:array[0..200001] of point;
n,n2,i,j,k,i1,i2:longint;
function sameLine(A,B,C:point):boolean;
var
ABx,ACx,ABy,ACy,k:longint;
begin
ABx:=B.X-A.X;
ACx:=C.X-A.X;
ABy:=B.Y-A.Y;
ACy:=C.Y-A.Y;
k:=ABx*ACy-ABy*ACx;
if (k=0) then sameLine:=true
else sameLine:=false;
end;
begin
readln(n);
if (n<=4) then begin
writeln('YES');
halt;
end;
for i:=1 to n do readln(Points[i].x,Points[i].y);
for i:=1 to 5 do for j:=i+1 to 5 do for k:=j+1 to 5 do if not (sameLine(Points[i],Points[j],Points[k])) then begin
i1:=i;
i2:=j;
goto x;
end;
writeln('NO');
halt;
x:
n2:=0;
for i:=1 to n do begin
if ((i=i1) or (i=i2)) then continue;
if not sameLine(Points[i1],Points[i2],Points[i]) then begin
inc(n2,1);
otherPoints[n2]:=Points[i];
end;
end;
if (n2<=2) then begin
writeln('YES');
halt;
end;
for i:=3 to n2 do begin
if not sameLine(otherPoints[1],otherPoints[2],otherPoints[i]) then begin
writeln('NO');
halt;
end;
end;
writeln('YES');
end.
Three points A, B and C lie on the same straight line, if vectors AB and AC are collinear or anti-collinear. We can check for collinearity using cross product of vectors - it should be zero.
#LU RD already described this approach is comment, but author probably missed it.
Note that method doesn't suffer from division by zero - there is no division at all.
ABx := B.X - A.X;
ACx := C.X - A.X;
ABy := B.Y - A.Y;
ACy := C.Y - A.Y;
Cross := ABx * ACy - ABy * ACx;
// for integer coordinates
if Cross = 0 then
A,B,C are collinear
If coordinates are float, one must consider some tolerance level. Variants:
//better if available:
if Math.IsZero(Cross)
if Math.SameValue(Cross, 0)
//otherwise
if Abs(Cross) <= SomeEpsilonValue
If coordinate range is very large, numerical error might be significant, so it is worth to normalize tolerance by squared magnitude of coordinate differences:
if Math.IsZero(Cross / Max(ABx * ABx + ABy * ABy, ACx * ACx + ACy * ACy))
I guess the answer to the Q should be devided into two parts.
I. How to know that the given three points belong to the same line?
The answer to this part of the Q was given by #Lurd and then expanded by Mbo.
Let us name their solution function BelongToOneLine(Pnts: array [1..3] of TPoint): boolean; We can consider this part solved.
II. How to decrease time consumption of the algorithm or in other words: how to avoid calling BelongToOneLilne with every possible combination of points as parameters?
Here is the algorithm.
We select 5 distinct points from the task set. 5 is enough (check combination possibilities).
We find the answer to the question if there are at least three points from given five that belong to a single line.
if No - then we do not need to iterate the remaining poins - the answer is that we require more then two lines.
if Yes - (say poins Pt1, Pt2 and Pt3 belong to the same line and Pt4 and Pt5 - don't).
Then we store the points that do not belong to the line Pt1-Pt2-Pt3 from the group-of-five in a distinct array of "outsider" points (or store their indexes in the main array). It may have Length = 0 by the end of this step. This will not affect the rest of the algo.
We get the boolean result of the function BelongToOneLine([Pt1, Pt2, Pt[i]]).
if Yes - we skip the point - it belongs to the line Pt1-Pt2-Pt3.
if No - we store this point in the "outsiders" array.
We watch the length of the OutsidersArray.
if it is <= 2 then the answer to the whole Q is Yes, they do belong to 2 or less lines.
if >2 then we iterate the function BelongToOneLine([OutsiderPt1, OutsiderPt2, OutsiderPt[i]]) until High(OutsiderArray) or until when OutsiderPt[i] does not belong to OutsiderPt1-OutsiderPt2 line. All points of OutsiderArray must belong to the same line otherwise the answer to the whole Q will be negative.
Math note
Without optimization the inerations count will be n! / ((n - k)! * k!).
With the optimization it will be:
5! / ((5-3)! * 3!) + (n - 3) + P(q)outsiders * n that is about 15000 for n = 10000. Most negative count - about 20000.
And another optimization note
Replace declaration of TPoint with integer variables.
Search Results
Featured snippet from the web
For n=1: you need two lines to intersect, so the maximum number of intersections is 0. n=2: Two distinct lines will always intersect in at most one point irrespective of dimensions. ... Explanation: Each set of 2 lines can intersect at one point. Or one point is common intersection for 2 lines.
I have 2 tables like this
As you can see, if you look at Total you can see the score of each player in 3 rounds. I have to do a list (from the 1st to the 12th) indicating the highest score.
Here the player with 28 points, must have the number 1 (instead of that 8 which is generated by default), the player with 22 must have the number 2 instead of 11... So I have to sort the TOTAL columns and return the position in the correct label.
When I click the button I underlined, the procedure is called:
var vettore:array[1..12] of integer;
indici:array[1..12] of integer;
i:smallint;
begin
for i := 1 to 6 do
begin
vettore[i]:= StrToInt(StringGrid1.Cells[5,i]); //col,row
indici[i] := i;
end;
for i := 6 to 12 do
begin
vettore[i]:= StrToInt(StringGrid2.Cells[5,i]); //col,row
indici[i] := i;
end;
In this way I load inside vettore all the TOTAL numbers in the rows of both tables, and in indici you can find the number of the label on the right of the table (they indicates the position). Now I thought I could use any sorting method since I have only 12 elements (like the Quick Sort).
My problem is this: how can I change the labels texts (the ones on right of the tables) according with the sorted array? It's like the picture above shows.
Every label is called (starting from 1) mvp1, mvp2, mvp3, mvp4... I think this can be helpful because if (maybe) I will have to do a for loop for change the text of each label, I can use a TFindComponent.
If it could be helpful, here there is the function I wrote with javascript on my website (it works):
var totals = [], //array with the scores
indices = []; //array with the indices
for (var i=0; i<6; i++) {
totals[i] = parseInt(document.getElementById('p'+i).value, 10);
indices[i] = i;
}
for (var i=6; i<12; i++) {
totals[i] = parseInt(document.getElementById('p'+i).value, 10);
indices[i] = i;
}
indices.sort(function(a, b) {
return totals[b]- totals[a];
});
for (var i=0; i<indices.length; i++) {
document.getElementById('mvp'+(indices[i]+1)).value = (i+1);
}
AS. Since only delphi is listed in tags, that means that any Delphi version is okay. I'd refer to delphi-xe2.
1st we would use Advanced Records to hold the data for a single participant. Some links are below, google for more.
http://docwiki.embarcadero.com/RADStudio/XE5/en/Structured_Types#Records_.28advanced.29
http://delphi.about.com/od/adptips2006/qt/newdelphirecord.htm
http://sergworks.wordpress.com/2012/03/13/record-constructors-in-delphi/
.
type
TClanResults = record
public
type All_GPs = 1..3;
var GP: array [All_GPs] of Cardinal;
var Players: string;
var Clan_ID: integer;
private
function CalcTotal: Cardinal;
function CalcAverage: single; inline;
public
property Total: Cardinal read CalcTotal;
property AVG: single read CalcAverage;
end;
{ TClanResults }
function TClanResults.CalcAverage: single;
begin
Result := Self.Total * ( 1.0 / Length(GP) );
end;
function TClanResults.CalcTotal: Cardinal;
var score: cardinal;
begin
Result := 0;
for score in GP do
Inc(Result, score);
end;
The expression Self.Total * ( 1.0 / Length(GP) ); can be also written as Self.Total / Length(GP). However i'd like to highlight some Delphi quirks here.
in Pascal there are two division operators: float and integer; 3 div 2 = 1 and 3 / 2 = 1.5. Choosing wrong one causes compilation errors at best and data precision losses at worst.
I'd prefer explicit typecast from integer Length to float, but Delphi does not support it. So i multiply by 1.0 to cast. Or i may add 0.0.
Division takes a lot longer than multiplication - just do it with pen and paper to see. When you have a data-crunching loop, where all elements are divided by the same number, it is good idea to cache 1 / value into a temp variable, and then mutiply each element by it instead. Since GP is of fixed size, it is compiler that calculates (1.0 / Length(GP)) and substitutes this constant. If you would allow different clans to have different amount of games - and turn GP into being dynamic arrays of different sizes - you would be to explicitly add a variable inside the function and to calc coeff := 1.0 / Length(GP); before loop started.
Now we should make a container to hold results and sort them. There can be several approaches, but we'd use generics-based TList<T>.
http://docwiki.embarcadero.com/Libraries/XE5/en/System.Generics.Collections.TList
http://docwiki.embarcadero.com/Libraries/XE5/en/System.Generics.Collections.TList.Sort
http://docwiki.embarcadero.com/Libraries/XE5/en/System.Generics.Defaults.TComparer.Construct
http://docwiki.embarcadero.com/Libraries/XE5/en/System.Generics.Defaults.TComparison
The TList is an object, so you would have to CREATE it and to FREE it. I think you can make it a PUBLIC property of your MainForm, then create the list in TMainForm.OnCreate event and free it in TMainForm.OnDestroy event.
Another, lazier approach, would be using a regular dynamic array and its extensions.
http://docwiki.embarcadero.com/RADStudio/XE5/en/Structured_Types#Dynamic_Arrays
http://docwiki.embarcadero.com/Libraries/XE5/en/System.TArray
http://docwiki.embarcadero.com/Libraries/XE5/en/System.SetLength
http://docwiki.embarcadero.com/Libraries/XE5/en/System.Generics.Collections.TArray.Sort
http://docwiki.embarcadero.com/CodeExamples/XE5/en/Generics_Collections_TArray_(Delphi)
However, i'll use TList below. Again, i assume that other routines in you program already and correctly create and destroy the given var ClanData: TList<TClanResults>; object instance.
type
TClansTable = TList<TClanResults>;
procedure TMainForm.Input;
var row: TClanResults
begin
Self.ClanData.Clear;
row.Clan_ID := 1;
row.Players := JclStringList.Add(['John', 'James', 'Jenny']).Join(' and ');
row.GP[1] := 2;
row.GP[1] := 5;
row.GP[1] := 7;
Self.ClanData.Add(row);
row.Clan_ID := 2;
row.Players := JclStringList.Add(['Mary', 'Mark', 'Marge']).Join(' and ');
row.GP[1] := 3;
row.GP[1] := 6;
row.GP[1] := 2;
Self.ClanData.Add(row);
...
end;
procedure SortOnTotal(const Table: TClansTable);
begin
Table.Sort(
TComparer<TClanResults>.Construct(
function(const Left, Right: TClanResults): Integer
begin Result := - (Left.Total - Right.Total) end
// negating since we need reversed order: large to little
)
);
end;
Now finally we need to know how to show that table on the screen. I would use typical TStringGrid as the most simplistic widget. I suggest you to look some advanced string grid from JediVCL or something from Torry.net so you would be able to specify columns styles. It is obvious that integers should be right-aligned on the screen and averages should be comma-aligned. However stock TStringGrid does not have kind of GetCellStyle event, so you would need some advanced grid derivative to add it. It is left as your home-task.
http://docwiki.embarcadero.com/RADStudio/XE5/en/String_Grids
http://docwiki.embarcadero.com/Libraries/XE5/en/Vcl.Grids.TStringGrid_Properties
Delphi TStringGrid Flicker - remains as your homework too.
.
procedure TMainForm.DumpTableToGrid(const Data: TClansTable; const grid: TStringGrid);
const TableFields = 8;
var row: integer;
ss: array of string;
res: TClanResults;
procedure DumpTheRow; var col: integer;
begin
for col := 0 to TableFields - 1 do begin
grid.Cells[ col, row ] := ss[ col ];
end;
begin
grid.Options := [ goFixedVertLine, goVertLine, goHorzLine, goColSizing, goColMoving, goThumbTracking ];
grid.ColCount := TableFields;
SetLength( ss, TableFields );
grid.RowCount := 1 + Data.Count;
grid.FixedRows := 1;
grid.FixedColumns := 1;
row := 0; // headers
ss[0] := ''; // number in the row, self-evident
ss[1] := 'Players';
ss[2] := 'GP 1';
....
ss[7] := 'Clan ID';
DumpTheRow;
for res in Data do begin // we assume Data already sorted before calling this
Inc(row);
ss[0] := IntToStr( row );
ss[1] := res.Players;
ss[2] := IntToStr( res.GP[1] );
...
ss[6] := FloatToStrF( res.AVG, ffFixed, 4, 2);
ss[7] := IntToStr( res.Clan_ID );
DumpTheRow;
end;
end;
Now, it is unclear what you mean by those labels. I can guess, that you want to show there ranks according to both your two clans combined positions. The externals labels are a bad idea for few reasons.
FindComponent is not too fast. Okay, you may find them once, cache in array of TLabel and be done. But why bother with extra workarounds?
user may resize the window, making it taller or shorter. Now there are 3 labels visible, in a minute there would be 30 labels visible, in a minute there will be 10 labels... How would you re-generate them in runtime ? So there would be enough of those always and in proper positions ? Actually just put them into the grid itself.
VCL sucks at form scaling. Now that Winodws 8.1 is out the fonts resolution might be different on different displays. There would be usually 96DPI on you main display, but as you would drag the window onto your secondary display there would be 120DPI, and on your mate's laptop (examples: Lenovo ThinkPad Yoga Pro and Lenovo IdeaPad Yoga 2) there might be like 200DPI or Retina-grade 300DPI. Still you would have to control your labels so their text would be shown exactly to the right of grid rows text, no matter what value would be rows of each height and each font.
So, i think they should be INSIDE the row. If you want to highlight them - use bold font, or coloured, or large, or whatever inside the grid.
TRanks = record min, max: word; end;
TClanResults = record
...
RanksCombined: TRanks;
...
end;
You correctly shown that some clans might have the same results and share the rank.
Before continuing you, as a JS user, have to notice a basis difference between record and class datatypes. record is operated by value while class is operated by reference. That means for class instances and variables you have to manually allocate memory for new elements and to dispose it for no longer used ones. Since class variable is a reference to some anonymous class instance(data). Hence the different containers of class-type elements can point to the single real element(data, instance), providing for easy data changing and cheaper sorting. Then for record instances (and record variable IS record data) you don't care about memory allocation and life times, yet would have copying data between different record instances, and if you change the one instance, to apply it to other containers you would have to copy it back. This difference is very visible in for element in container loops, whether we can change element.field or not.
http://docwiki.embarcadero.com/Libraries/XE2/en/System.Generics.Collections.TObjectList.Create
So let us have few more data structures for sorting and calculating. For example
TAvgAndRanks = class
avg: single; rank: TRanks;
table: TClansTable; idx: integer;
end;
We'll have then modification for the data dumper:
procedure TMainForm.DumpTableToGrid(const Data: TClansTable; const grid: TStringGrid);
const TableFields = 9;
...
row := 0; // headers
....
ss[7] := 'Clan ID';
ss[8] := 'Rank';
DumpTheRow;
...
ss[7] := IntToStr( res.Clan_ID );
with res.RanksCombined do
if min = max
then ss[9] := IntToStr(min)
else ss[9] := IntToStr(min) + ' - ' + IntToStr(max);
DumpTheRow;
Another approach would be to keep ranks externally using something like
TClanPtr = record table: TClansTable; idx: integer; end;
TClanSortData = record avg: single; rank: TRanks; end;
TClanRanksCombined = TDictionary<TClanPtr, TClanSortData>;
This approach is more extensible (allows in different window "attach" different extended data to the clans), but would require much more boilerplate. If you liek it more, your homework would be to implement it.
procedure MakeRanks(const clans: array of TClansTable);
var tab: TClansTable; idx: integer;
total: TObjectList<TAvgAndRanks>;
ar : TAvgAndRanks;
res: TClanResults;
// for spanning ranks with same avg
r_curr, r_min: word;
r_span, r_idx: integer;
r_avg: single;
r_chg: boolean;
begin
total := TObjectList<TAvgAndRanks>.Create( True ); // auto-free by container
try
for tab in clans do
for idx := 0 to tab.Count - 1 do begin
res := tab[ idx ];
ar := TAvgAndRanks.Create; // but creation is still manual
ar.table := tab;
ar.idx := idx;
ar.avg := res.AVG;
total.Add(ar);
end;
if total.Count <= 0 then Abort;
if total.Count = 1 then begin
ar := total[0];
res := ar.table[ ar.idx ];
res.RanksCombined.min := 1;
res.RanksCombined.max := 1;
ar.table[ ar.idx ] := res; // copying back updated data
Exit; // from procedure - nothing to do
end;
total.Sort(
TComparer<TAvgAndRanks>.Construct(
function(const Left, Right: TAvgAndRanks): Integer
begin Result := - (Left.avg - Right.avg) end
// negating since we need reversed order: large to little
)
);
(***** calculating ranks with spans ****)
r_curr := 1;
r_min := 1;
r_span := 0;
r_idx := 0;
r_avg := total[0].avg;
for idx := 1 to total.Count - 1 do begin
ar := total[ idx ];
inc(r_curr);
if r_avg = ar.avg then inc(r_span);
if (r_avg <> ar.avg) or (idx = total.Count - 1) then begin
for r_idx := r_idx to r_idx + r_span do begin
with total[ r_idx ] do begin // class == reference, can update directly
rank.min := r_min;
rank.max := r_min + r_span;
end;
end;
Assert( (r_curr = r_min + r_span + 1) or ( r_avg = ar.avg ) );
r_min := r_curr;
r_span := 0;
r_idx := idx;
r_avg := ar.avg;
end;
end;
(*** saving calculated ranks ***)
for ar in total do begin
res := ar.table[ ar.idx ];
res.RanksCombined := ar.ranks;
ar.table[ ar.idx ] := res; // copying back updated data
end;
finally
Total.Destroy;
end;
end;
Because of a documented rounding issue in Delphi XE2, we are using a special rounding unit available on the Embarcadero site named DecimalRounding_JH1 to achieve true bankers rounding. A link to the unit can be found here:
DecimalRounding_JH1
Using this unit's DecimalRound function with numbers containing a large number of decimal place we
This is the rounding routine from the DecimalRounding_JH1 unit. In our example we call this DecimalRound function with the following parameters (166426800, 12, MaxRelErrDbl, drHalfEven) where maxRelErrDbl = 2.2204460493e-16 * 1.234375 * 2
Function DecimalRound(Value: extended; NDFD: integer; MaxRelErr: double;
Ctrl: tDecimalRoundingCtrl = drHalfEven): extended;
{ The DecimalRounding function is for doing the best possible job of rounding
floating binary point numbers to the specified (NDFD) number of decimal
fraction digits. MaxRelErr is the maximum relative error that will allowed
when determining when to apply the rounding rule. }
var i64, j64: Int64; k: integer; m, ScaledVal, ScaledErr: extended;
begin
If IsNaN(Value) or (Ctrl = drNone)
then begin Result := Value; EXIT end;
Assert(MaxRelErr > 0,
'MaxRelErr param in call to DecimalRound() must be greater than zero.');
{ Compute 10^NDFD and scale the Value and MaxError: }
m := 1; For k := 1 to abs(NDFD) do m := m*10;
If NDFD >= 0
then begin
ScaledVal := Value * m;
ScaledErr := abs(MaxRelErr*Value) * m;
end
else begin
ScaledVal := Value / m;
ScaledErr := abs(MaxRelErr*Value) / m;
end;
{ Do the diferent basic types separately: }
Case Ctrl of
drHalfEven: begin
**i64 := round((ScaledVal - ScaledErr));**
The last line is where we get a floating point error.
Any thoughts on why this error is occurring?
If you get an exception, that means you cannot represent your value as an double within specified error range.
In other words, the maxRelErrDbl is too small.
Try with maxRelErrDbl = 0,0000000001 or something to test if I am right.
I have a BIG problem here and do not even know how to start...
In short explanation, I need to know if a number is in a set of results from a random combination...
Let me explain better: I created a random "number" with 3 integer chars from 1 to 8, like this:
procedure TForm1.btn1Click(Sender: TObject);
var
cTmp: Char;
sTmp: String[3];
begin
sTmp := '';
While (Length(sTmp) < 3) Do
Begin
Randomize;
cTmp := IntToStr(Random(7) + 1)[1];
If (Pos(cTmp, sTmp) = 0) Then
sTmp := sTmp + cTmp;
end;
edt1.Text := sTmp;
end;
Now I need to know is some other random number, let's say "324" (example), is in the set of results of that random combination.
Please, someone can help? A link to get the equations to solve this problem will be enough...
Ok, let me try to add some useful information:
Please, first check this link https://en.wikipedia.org/wiki/Combination
Once I get some number typed by user, in an editbox, I need to check if it is in the set of this random combination: S = (1..8) and k = 3
Tricky, hum?
Here is what I got. Maybe it be usefull for someone in the future. Thank you for all people that tried to help!
Function IsNumOnSet(const Min, Max, Num: Integer): Boolean;
var
X, Y, Z: Integer;
Begin
Result := False;
For X := Min to Max Do
For Y := Min to Max Do
For Z := Min to Max Do
If (X <> Y) and (X <> Z) and (Y <> Z) Then
If (X * 100 + Y * 10 + Z = Num) Then
Begin
Result := True;
Exit;
end;
end;
You want to test whether something is a combination. To do this you need to verify that the putative combination satisfies the following conditions:
Each element is in the range 1..N and
No element appears more than once.
So, implement it like this.
Declare an array of counts, say array [1..N] of Integer. If N varies at runtime you will need a dynamic array.
Initialise all members of the array to zero.
Loop through each element of the putative combination. Check that the element is in the range 1..N. And increment the count for that element.
If any element has a count greater than 1 then this is not a valid combination.
Now you can simplify by replacing the array of integers with an array of booleans but that should be self evident.
You have your generator. Once your value is built, do something like
function isValidCode( Digits : Array of Char; Value : String ) : Boolean;
var
nI : Integer;
begin
for nI := 0 to High(Digits) do
begin
result := Pos(Digits[nI], Value ) > 0;
if not result then break;
end;
end;
Call like this...
isValidCode(["3","2","4"], RandomValue);
Note : it works only because you have unique digits, the digit 3 is only once in you final number. For something more generic, you'll have to tweak this function. (testing "3","3","2" would return true but it would be false !)
UPDATED :
I dislike the nested loop ^^. Here is a function that return the nTh digit of an integer. It will return -1 if the digits do not exists. :
function TForm1.getDigits(value : integer; ndigits : Integer ) : Integer;
var
base : Integer;
begin
base := Round(IntPower( 10, ndigits-1 ));
result := Trunc( value / BASE ) mod 10;
end;
nDigits is the digits number from right to left starting at 1. It will return the value of the digit.
GetDigits( 234, 1) returns 4
GetDigits( 234, 2) returns 3
GetDigits( 234, 3) returns 2.
GetDigits( 234, 4) returns 0.
Now this last function checks if a value is a good combination, specifying the maxdigits you're looking for :
function isValidCombination( value : integer; MinVal, MaxVal : Integer; MaxDigits : Integer ) : Boolean;
var
Buff : Array[0..9] of Integer;
nI, digit: Integer;
begin
ZeroMemory( #Buff, 10*4);
// Store the count of digits for
for nI := 1 to MaxDigits do
begin
digit := getDigits(value, nI);
Buff[digit] := Buff[digit] + 1;
end;
// Check if the value is more than the number of digits.
if Value >= Round(IntPower( 10, MaxDigits )) then
begin
result := False;
exit;
end;
// Check if the value has less than MaxDigits.
if Value < Round(IntPower( 10, MaxDigits-1 )) then
begin
result := False;
exit;
end;
result := true;
for nI := 0 to 9 do
begin
// Exit if more than One occurence of digit.
result := Buff[nI] < 2 ;
if not result then break;
// Check if digit is present and valid.
result := (Buff[nI] = 0) or InRange( nI, MinVal, MaxVal );
if not result then break;
end;
end;
Question does not seem too vague to me,
Maybe a bit poorly stated.
From what I understand you want to check if a string is in a set of randomly generated characters.
Here is how that would work fastest, keep a sorted array of all letters and how many times you have each letter.
Subtract each letter from the target string
If any value in the sorted int array goes under 0 then that means the string can not be made from those characters.
I made it just work with case insensitive strings but it can easily be made to work with any string by making the alphabet array 255 characters long and not starting from A.
This will not allow you to use characters twice like the other example
so 'boom' is not in 'b' 'o' 'm'
Hope this helps you.
function TForm1.isWordInArray(word: string; arr: array of Char):Boolean;
var
alphabetCount: array[0..25] of Integer;
i, baseval, position : Integer;
s: String;
c: Char;
begin
for i := 0 to 25 do alphabetCount[i] := 0; // init alphabet
s := UpperCase(word); // make string uppercase
baseval := Ord('A'); // count A as the 0th letter
for i := 0 to Length(arr)-1 do begin // disect array and build alhabet
c := UpCase(arr[i]); // get current letter
inc(alphabetCount[(Ord(c)-baseval)]); // add 1 to the letter count for that letter
end;
for i := 1 to Length(s) do begin // disect string
c := s[i]; // get current letter
position := (Ord(c)-baseval);
if(alphabetCount[position]>0) then // if there is still latters of that kind left
dec(alphabetCount[position]) // delete 1 to the letter count for that letter
else begin // letternot there!, exit with a negative result
Result := False;
Exit;
end;
end;
Result := True; // all tests where passed, the string is in the array
end;
implemented like so:
if isWordInArray('Delphi',['d','l','e','P','i','h']) then Caption := 'Yup' else Caption := 'Nope'; //yup
if isWordInArray('boom',['b','o','m']) then Caption := 'Yup' else Caption := 'Nope'; //nope, a char can only be used once
Delphi rocks!
begin
Randomize; //only need to execute this once.
sTmp := '';
While (Length(sTmp) < 3) Do
Begin
cTmp := IntToStr(Random(7) + 1)[1]; // RANDOM(7) produces # from 0..6
// so result will be '1'..'7', not '8'
// Alternative: clmp := chr(48 + random(8));
If (Pos(cTmp, sTmp) = 0) Then
sTmp := sTmp + cTmp;
IF SLMP = '324' THEN
DOSOMETHING; // don't know what you actually want to do
// Perhaps SET SLMP=''; to make sure '324'
// isn't generated?
end;
edt1.Text := sTmp;
end;