here's the code in Delphi:
function Perfect(x: Integer): Integer;
var
i, a: Integer;
begin
i := 1;
a := 0;
while i <= x div 2 do
begin
if (x mod i = 0) then
a := a + i;
i := i + 1;
end;
if x = a then
Result := x;
end;
Basically, it's a function that shows perfect numbers from given interval. I created a loop for to show these numbers but I have a problem because it also shows some random numbers when it's not a perfect number. So let's say I have [1;7] and then console shows that:
1969410929
1969410929
1969410929
1969410929
1969410929
6
1969410929
What can I do to show only right numbers?
Your code is failing to set the return value if the number is not perfect. In that scenario the returned value is ill defined. You must always set the return value. From the documentation:
If the function exits without assigning a value to Result or the function name, then the function's return value is undefined.
Since a function must return a value, your function is in a bind. What to return in case the value is not perfect? There is no good choice in my view. You do not need to return the number since you already know it. You passed it to the function after all.
So, you should change the design of the function to return a boolean indicating whether or not the number was perfect:
function IsPerfect(x: Integer): Boolean;
var
i, sum: Integer;
begin
sum := 0;
for i := 1 to x div 2 do
if x mod i = 0 then
inc(sum, i);
Result := x = sum;
end;
The code to call the function runs like this:
for i := 1 to 1000 do
if IsPerfect(i) then
Writeln(i);
Output
6
28
496
... "it also shows some random numbers when it's not a perfect number".
The reason for that is that you don't set the Result "variable" when it's not a perfect number. If you create a function that doesn't set the Result variable in all cases, the result of calling it will be undefined in those cases. Random describes it, though it's probably some kind of system, even if the system is just "whatever was left in memory where the Result variable was placed".
You need to determine what to return if it's not a perfect number, and make either of the following code changes:
Result := <what to return if not?>;
if x = a then
Result := x;
or this:
if x = a then
Result := x
else
Result := <what to return if not?>;
Related
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.
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 some problem again about list and binarysearch. In general, i have:
type
TMyArr = array [1..5] of Integer;
PMyList = record
Comb: TMyArr;
... // other fields
end;
TMyList = TList<PMyList>;
var
MyArr: TMyArr;
MyList: TMyList;
rMyList: PMyList;
i load value in array MyArr and want find element MyArr (with all values in it) in list TMyList, then i use:
rMyList.Comb := MyArr;
MyList.BinarySearch(rMyList, iIndex3, TDelegatedComparer<PMyList>.Construct(Compare));
with Compare so defined:
function CompareInt(const Left, Right: Integer): Integer;
begin
if Left < Right then
Result := -1
else if Left > Right then
Result := 1
else
Result := 0;
end;
function Compare(const Left, Right: PMyList): Integer;
begin
Result := CompareInt(Left.Comb[1], Right.Comb[1]);
if Result = 0 then
Result := CompareInt(Left.Comb[2], Right.Comb[2]);
if Result = 0 then
Result := CompareInt(Left.Comb[3], Right.Comb[3]);
if Result = 0 then
Result := CompareInt(Left.Comb[4], Right.Comb[4]);
if Result = 0 then
Result := CompareInt(Left.Comb[5], Right.Comb[5]);
end;
Now, my problem is that not every result is correct. In sense that often i have correct index of element and other time i have other index corresponding to other element, in casual.
As i can solve it? Where i have mistake?
I want only find index corresponding of MyArr in TMyArr.
Thanks again very much.
Your Compare function is just fine. If the binary search fails to work correctly then that can only be because the list is not ordered by the order defined by Compare. Call the Sort function on the list once you have finished populating, and before you start searching. When you call Sort, you must make sure that it use your compare function.
I am looking into modifying brightness/contrast/gamma of my display i found an api whose purpose i think is this but i didn't had much success implementing it... here is the code
var
i,j:Integer;
buf:array [0..2,0..255] of Word;
wBright:Word;
myDC:HDC;
begin
myDC:=GetDc(GetDesktopWindow);
GetDeviceGammaRamp(mydc,buf);
for i:=0 to 2 do
for j:=0 to 255 do
begin
buf[i][j]:=buf[i][j] + 100; //if i don't modify the values the api works
end;
SetDeviceGammaRamp(mydc,buf);
end;
I will be grateful if you point me into right direction. Thanks.
The last error says : The parameter is incorrect
The values in the array must really be a ramp, i.e. they map the possible R, G and B values to a brightness value. This way you can create funny effects too, but not with the routine below. Found something like this on the web:
uses Windows;
// SetDisplayBrightness
//
// Changes the brightness of the entire screen.
// This function may not work properly in some video cards.
//
// The Brightness parameter has the following meaning:
//
// 128 = normal brightness
// above 128 = brighter
// below 128 = darker
function SetDisplayBrightness(Brightness: Byte): Boolean;
var
GammaDC: HDC;
GammaArray: array[0..2, 0..255] of Word;
I, Value: Integer;
begin
Result := False;
GammaDC := GetDC(0);
if GammaDC <> 0 then
begin
for I := 0 to 255 do
begin
Value := I * (Brightness + 128);
if Value > 65535 then
Value := 65535;
GammaArray[0, I] := Value; // R value of I is mapped to brightness of Value
GammaArray[1, I] := Value; // G value of I is mapped to brightness of Value
GammaArray[2, I] := Value; // B value of I is mapped to brightness of Value
end;
// Note: BOOL will be converted to Boolean here.
Result := SetDeviceGammaRamp(GammaDC, GammaArray);
ReleaseDC(0, GammaDC);
end;
end;
Unfortunately, in my Win7 VM in Parallels on a Mac, I can't test his, but it should work on most normal Windows PCs.
Edit
FWIW, I ran it in my Win7 VM and the routine returns True. If I use other values, e.g.
Value := 127 * I;
the routine returns False and
ShowMessage(SysErrorMessage(GetLastError));
displays
The parameter is incorrect
Changing this to:
Value := 128 * I;
returns True again. I assume the values must form some kind of slope (or ramp). This routine creates a linear ramp. I guess you can also use other kinds, e.g. a sigmoid, to achieve other effects, like higher contrast.
I can't, of course, see any differences in brightness in the VM, sorry.
Update: But it seems to work for David Heffernan and I could just test it on my sister in law's laptop, and there it works too.
I'm defecting from C# to Delphi 2009, I'm liking it so far very much.
I wrote a binary search procedure, which works fine. I added a simple if-else statement at the end of my proc and it just doesn't fire! I can't see anything wrong with it and am embarrassed to have to say I am stuck. Please help!
procedure BinSearch;
var
min,max,mid, x: integer;
A : array[0..4] of integer;
rslt : integer;
begin
writeln('binary search');
A[0] := 34; A[1] := 65; A[2] := 98; A[3] := 123; A[4] := 176;
listarray(a);
x := 62;
min := 0;
max := 4;
repeat
begin
mid := (min + max) div 2;
if x > A[mid] then
min := mid + 1
else
max := mid - 1;
end;
until (A[mid] = x) or (min > max);
writeln(mid);
writeln(a[mid]);
if A[mid] = x then
rslt := mid
else
rslt := not mid;
if 54 = 65 then
rslt := mid
else
rslt := not mid;
end;
It's the if A[mid] = x then one that won't fire. when debugging neither true or false branches fire, the debugger just skips straight over them. Also the if 54 = 65 then which is just a test does the same.
The if inside my repeat loop works fine though.
If I copy the problem if statement into a mini test proc, and then call the proc it works, so it makes me think it's something else in the proc like a missing ; causing something strange to happen but I cannot see it. Please help!
The Delphi compiler is pretty smart, and it will happily remove unused code. When I compile your code I get compiler hints saying "Value assigned to 'rslt' never used". Since the value is never used, the compiler just skips over those statements.
If you add a Writeln(rslt); to the end of your procedure, you will find that the debugger will now trace through your if statement.
It could be that the debugger is just skipping over those statements even though they are actually running. Make sure that all of the options are turned on in the debugging options. In Delphi 7, they are under Project\Options under the Compiler tab.
The "Begin" statement just after the "Repeat" statement shouldn't be there. A "Repeat" doesn't use a begin. I would remove it just to be sure that it doesn't cause any problems.
"rslt" is not used. Therefore Delphi optimizes it out.
Obviously, you want to return your result. So change your declaration to:
procedure BinSearch(var rslt: integer);
or better, make it a function:
function BinSearch: integer;
and at the end put in:
Result := rslt;
Do either of the above, and you'll find that those statements are no longer skipped over because rslt is now being used.
But, you'll find you will have a problem with your statement:
rslt := not mid;
because mid is an integer. I'm not sure what you want to return here, but I know you don't want the "not" operator to be applied to "mid".
Look at this code that I got from wikibooks. It might help you figure it out.
(* Returns index of requested value in an integer array that has been sorted
in ascending order -- otherwise returns -1 if requested value does not exist. *)
function BinarySearch(const DataSortedAscending: array of Integer;
const ElementValueWanted: Integer): Integer;
var
MinIndex, MaxIndex: Integer;
{ When optimizing remove these variables: }
MedianIndex, MedianValue: Integer;
begin
MinIndex := Low(DataSortedAscending);
MaxIndex := High(DataSortedAscending);
while MinIndex <= MaxIndex do begin
MedianIndex := (MinIndex + MaxIndex) div 2; (* If you're going to change
the data type here e.g. Integer to SmallInt consider the possibility of
an overflow. All it needs to go bad is MinIndex=(High(MinIndex) div 2),
MaxIndex = Succ(MinIndex). *)
MedianValue := DataSortedAscending[MedianIndex];
if ElementValueWanted < MedianValue then
MaxIndex := Pred(MedianIndex)
else if ElementValueWanted = MedianValue then begin
Result := MedianIndex;
Exit; (* Successful exit. *)
end else
MinIndex := Succ(MedianIndex);
end;
Result := -1; (* We couldn't find it. *)
end;