I've been learning Pascal (using the Free Pascal compiler) for a week now, and came across a seemingly easy exercise. Given a structure as shown below, find the maximal weighted branch:
1
4 9
7 0 2
4 8 6 3
A branch is any sequence of numbers, starting from the top (in this case: 1), when for every number the branch can expand either down-left or down-right. For example, the branch 1-4-0 can expand into either 1-4-0-8 or 1-4-0-6. All branches must start from the top and end at the bottom.
In this example, the maximal branch is 1-4-7-8, which gives us 20. In order to solve this question, I tried to use backtracking. The triangular structure was stored in an array of type 'triangle':
type triangle = array[1..MAX_NUM_OF_ROWS, 1..MAX_NUM_OF_ROWS] of integer;
Here's my implementation:
function findAux(data: triangle; dim: integer; i: integer; j:integer) : integer;
begin
if i = dim then
findAux := data[i][j]
else
if findAux(data, dim, i + 1, j + 1) > findAux(data, dim, i + 1, j) then
findAux := data[i+1][j+1] + findAux(data, dim, i + 1, j + 1);
else
findAux := data[i+1][j] + findAux(data, dim, i + 1, j);
end;
function find_heaviest_path(data: triangle; dim: integer) : integer;
begin
find_heaviest_path := findAux(data, dim, 1, 1);
end;
As you can see, I've used an auxiliary function. Unfortunately, it doesn't seem to give the right result. For the structure seen above, the result I get is 27, which is 7 points off. What am I missing? How does the implementation look overall? I should add that the maximal number of rows is 100, for this exercise. If clarification is needed, please don't hesitate to ask.
Your findAux is adding the wrong value to the recursively obtained result. As an aside, you can neaten the code a bit using some local variables. A corrected version of findAux:
uses math;
...
function findAux(data: triangle; dim: integer; i: integer; j:integer) : integer;
var
left, right: integer;
begin
if i = dim then
findAux := data[i][j]
else begin
left := findAux(data, dim, i + 1, j);
right := findAux(data, dim, i + 1, j + 1);
findAux := data[i][j] + Max(left, right);
end;
end;
Related
This function is a school practice problem (it is running but does not work properly).
My task is to call for a integer from the user.
When the number arrives, my task is to write out (with a recursive algorithm)
what is the sum of the number with the numbers before the given number.
For example if our number is 10 then the upshot is 55 because 1+2+3+4+5+6+7+8+9+10 = 55, etc.
I've already tried to write this code:
function egesszamosszeg(n:integer) : integer;
begin
egesszamosszeg:=0
if n=1 then
egesszamosszeg:=1
else
for n:=1 to egesszamosszeg do
begin
egesszamosszeg:=egesszamosszeg+1;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var egesszam:integer;
begin
egesszam:=strtoint(Inputbox('','Give an integer please!',''));
Showmessage(inttostr(Egesszamosszeg(egesszam)));
end;
My problem is that I do not know what is the main problem with this code.
I do not know what is the main problem with this code.
There are several problems with your code: it's iterative, not recursive; it's way too complicated; this loop:
for n:=1 to egesszamosszeg do
is effectively:
for n:=1 to 0 do
Consider this simple function which effectively implements the gist of your problem:
function egesszamosszeg(n:integer) : integer;
begin
egesszamosszeg := n;
if (n > 1) then
egesszamosszeg := egesszamosszeg + egesszamosszeg(n - 1);
end;
begin
writeln(egesszamosszeg(10));
end.
You are simply trying to increment egesszamosszeg (couldn't you use an easier name?), instead of adding the consecutive numbers to it. But your loop is wrong: eggesszamosszeg is 0, so you are in fact doing for n := 1 to 0 do. That loop will never run. Don't re-use n, use another variable for the loop index:
for i := 1 to n do
egesszamosszeg := egesszamosszeg + i;
But you say it must be recursive, so it must call itself with a different parameter value. Then do something like:
function egesszamosszeg(n: integer): integer;
begin
if n = 1 then // terminating condition
egesszamosszeg := 1
else
egesszamosszeg := n + egesszamosszeg(n - 1); // recursion
end;
In most Pascals, you can use the pseudo-variable Result instead of the function name. Often, that makes typing a little easier.
FWIW, did you know that you could make this a little simpler and do not need recursion or iteration at all? The result can be calculated directly:
function egesszamosszeg(n: Integer): Integer;
begin
result := n * (n + 1) div 2;
end;
For 1..10, that will give 10 * 11 div 2 = 55 too.
See: https://www.wikihow.com/Sum-the-Integers-from-1-to-N
In effect, you count (1+10) + (2+9) + (3+8) + (4+7) + (5+6) = 5 * 11 = 55. You can do the same for any positive number. Same with 1..6: (1+6) + (2+5) + (3+4) = 3 * 7 = 21.
That leads to the formula:
sum = n * (n + 1) div 2
(or actually:
n div 2 * (n+1) // mathematically: n/2 * (n+1)
which is the same).
I have the following program:
procedure Main with SPARK_Mode is
F : array (0 .. 10) of Integer := (0, 1, others => 0);
begin
for I in 2 .. F'Last loop
F (I) := F (I - 1) + F (I - 2);
end loop;
end Main;
If I run gnatprove, I get the following result, pointing to the + sign:
medium: overflow check might fail
Does this mean that F (I - 1) could be equal to Integer'Last, and adding anything to that would overflow? If so, then is it not clear from the flow of the program that this is impossible? Or do I need to specify this with a contract? If not, then what does it mean?
A counterexample shows that indeed gnatprove in this case worries about the edges of Integer:
medium: overflow check might fail (e.g. when F = (1 => -1, others => -2147483648) and I = 2)
Consider adding a loop invariant to your code. The following is an example from the book "Building High Integrity Applications with Spark".
procedure Copy_Into(Buffer : out Buffer_Type;
Source : in String) is
Characters_To_Copy : Buffer.Count_Type := Maximum_Buffer_Size;
begin
Buffer := (Others => ' '); -- Initialize to all blanks
if Source'Length < Characters_To_Copy then
Characters_To_Copy := Source'Length;
end if;
for Index in Buffer.Count_Type range 1..Characters_To_Copy loop
pragma Loop_Invariant
(Characters_To_Copy <= Source'Length and
Characters_To_Copy = Characters_To_Copy'Loop_Entry);
Buffer (Index) := Source(Source'First + (Index - 1));
end loop;
end Copy_Into;
This is already an old question, but I would like to add an answer anyway (just for future reference).
With the advancement of provers, the example as stated in the question now proves out-the-box in GNAT CE 2019 (i.e. no loop invariant needed). A somewhat more advanced example can also be proven:
main.adb
procedure Main with SPARK_Mode is
-- NOTE: The theoretical upper bound for N is 46 as
--
-- Fib (46) < 2**31 - 1 < Fib (47)
-- 1_836_311_903 < 2_147_483_647 < 2_971_215_073
-- NOTE: Proved with Z3 only. Z3 is pretty good in arithmetic. Additional
-- options for gnatprove:
--
-- --prover=Z3 --steps=0 --timeout=10 --report=all
type Seq is array (Natural range <>) of Natural;
function Fibonacci (N : Natural) return Seq with
Pre => (N in 2 .. 46),
Post => (Fibonacci'Result (0) = 0)
and then (Fibonacci'Result (1) = 1)
and then (for all I in 2 .. N =>
Fibonacci'Result (I) = Fibonacci'Result (I - 1) + Fibonacci'Result (I - 2));
---------------
-- Fibonacci --
---------------
function Fibonacci (N : Natural) return Seq is
F : Seq (0 .. N) := (0, 1, others => 0);
begin
for I in 2 .. N loop
F (I) := F (I - 1) + F (I - 2);
pragma Loop_Invariant
(for all J in 2 .. I =>
F (J) = F (J - 1) + F (J - 2));
-- NOTE: The loop invariant below helps the prover to proof the
-- absence of overflow. It "reminds" the prover that all values
-- from iteration 3 onwards are strictly monotonically increasing.
-- Hence, if absence of overflow is proven in this iteration,
-- then absence is proven for all previous iterations.
pragma Loop_Invariant
(for all J in 3 .. I =>
F (J) > F (J - 1));
end loop;
return F;
end Fibonacci;
begin
null;
end Main;
This loop invariant should work - since 2^(n-1) + 2^(n-2) < 2^n - but I can't convince the provers:
procedure Fibonacci with SPARK_Mode is
F : array (0 .. 10) of Natural := (0 => 0,
1 => 1,
others => 0);
begin
for I in 2 .. F'Last loop
pragma Loop_Invariant
(for all J in F'Range => F (J) < 2 ** J);
F (I) := F (I - 1) + F (I - 2);
end loop;
end Fibonacci;
You can probably convince the provers with a bit of manual assistance (showing how 2^(n-1) + 2^(n-2) = 2^(n-2) * (2 + 1) = 3/4 * 2^n < 2^n).
I am trying to compute a Log Likelihood score for occurrence of pairs of words in text and am getting the same anomalous results in my Delphi implementation which I've derived from Java and Python sources found online. Ted Dunning who published on this source in 1993 gives these results for one particular pair:
K11 (AB, ie joint frequency) = 110,
K12 (word A without B nearby) = 2442,
K21 (B without A nearby) = 111
K22 (number of words other than A or B in the text) = 29114
and gives the desired result as 270.72
Dunning also gives an implementation in R at
http://tdunning.blogspot.co.uk/2008/03/surprise-and-coincidence.html
Computing the log-likelihood ratio score (also known as G2) is very
simple, LLR = 2 sum(k) (H(k) - H(rowSums(k)) - H(colSums(k)))
where H is Shannon's entropy, computed as the sum of (k_ij / sum(k)) log (k_ij / sum(k)) . In R, this function is defined as
H = function(k) {N = sum(k) ; return (sum(k/N * log(k/N + (k==0)))}
but I do not know R and am unsure how to translate that to Pascal.
My translation attempts include these functions
function LnOK(x : integer): extended;
begin
if x<=0 then Result :=0
else Result := Ln(x);
end;
function Entropy2(a, b: Integer): extended;
begin
Result := LnOK(a + b) - LnOK(a) - LnOK(b);
end;
function Entropy4(a, b, c, d: Integer): extended;
begin
Result := LnOK(a + b + c + d) - LnOK(a) - LnOK(b) - LnOK(c) - LnOK(d);
end;
function Log_likelihood_from_Java(f1, f2, joint, total_tokens: Integer):
single;
var
k11, k12, k21, k22: Integer;
matrixEntropy, rowEntropy, colEntropy: extended;
begin
k11 := joint;
k12 := f2 - joint;
k21 := f1 - joint;
k22 := total_tokens - f1 - f2 + joint;
rowEntropy := Entropy2(k11 + k12, k21 + k22);
colEntropy := Entropy2(k11 + k21, k12 + k22);
matrixEntropy := Entropy4(k11, k12, k21, k22);
if (rowEntropy + colEntropy < matrixEntropy) then
Result := 0.0 // round off error
else
Result := 2.0 * (rowEntropy + colEntropy - matrixEntropy);
end;
The above returns 7.9419 instead of the desired 270.72 when it's called like this:
Log_likelihood_from_Java(2552, 221, 110, 31777);
Grateful for help!
I've found the issue in the translation of the LnOk function which should be as follows:
function LnOK(x: Integer): Extended;
begin
if x = 0 then
Result := 0
else
Result := x * Ln(x);
end;
Off topic
As a side note if I'm allowed, just to improve the coding style, you might prefer to overload the Entropy functions instead of calling them with different names:
function Entropy(a, b: Integer): Extended; overload;
begin
Result := LnOK(a + b) - LnOK(a) - LnOK(b);
end;
function Entropy(a, b, c, d: Integer): Extended; overload;
begin
Result := LnOK(a + b + c + d) - LnOK(a) - LnOK(b) - LnOK(c) - LnOK(d);
end;
I can't make any sense of the code that you wrote which bears no obvious relationship to the R code to which you linked. I did not make any attempt to reconcile these differences.
Here's a literal translation of the R code. The algorithm is much simpler written this way as I am sure you will agree.
{$APPTYPE CONSOLE}
uses
SysUtils, Math;
type
TVector2 = array [1..2] of Double;
TMatrix2 = array [1..2] of TVector2;
function rowSums(const M: TMatrix2): TVector2;
begin
Result[1] := M[1,1] + M[1,2];
Result[2] := M[2,1] + M[2,2];
end;
function colSums(const M: TMatrix2): TVector2;
begin
Result[1] := M[1,1] + M[2,1];
Result[2] := M[1,2] + M[2,2];
end;
function H(const k: array of Double): Double;
var
i: Integer;
N, kOverN: Double;
begin
N := Sum(k);
Result := 0.0;
for i := low(k) to high(k) do begin
kOverN := k[i]/N;
if kOverN>0.0 then begin
Result := Result + kOverN*Ln(kOverN);
end;
end;
end;
function LLR(const M: TMatrix2): Double;
var
k: array [1..4] of Double absolute M; // this is a little sneaky I admit
rs, cs: TVector2;
begin
rs := rowSums(M);
cs := colSums(M);
Result := 2.0*Sum(k)*(H(k) - H(rs) - H(cs));
end;
var
M: TMatrix2;
begin
M[1,1] := 110;
M[1,2] := 2442;
M[2,1] := 111;
M[2,2] := 29114;
Writeln(LLR(M));
end.
Output
2.70721876936232E+0002
I'm sure there's a way to do this elegantly in SML but I'm having difficulty keeping track of the number of iterations (basically the number of times my function has been called).
I'm trying to write a function that evaluates to a pair of numbers, one for the floor of the answer and the other for the remainder. So if you called:
divmod(11, 2), you'd get (5, 1) back.
Here's what I have so far:
divmod(number : int, divisor : int) =
if number < divisor then
(number, count)
else
divmod(number - divisor, divisor);
Obviously, I haven't set up my count variable so it won't compile but that's the idea of the algorithm. All that's left is initializing count to 0 and being able to pass it between recursive calls. But I'm only allowed the two parameters for this function.
I can, however, write auxiliary functions.
Thoughts?
If SML has support for nested functions you could do like this:
divmod(number : int, divisor : int) =
_divmod(n : int, d : int, count : int) =
if n < d then
(count, n)
else
_divmod(n - d, d, count + 1)
_divmod(number, divisor, 0)
Personally, I like the fact that SML isn't a pure functional language. Keeping track of function calls is naturally done via side effects (rather than explicitly passing a counter variable).
For example, given a generic recursive Fibonacci:
fun fib 0 = 0
| fib 1 = 0
| fib n = fib(n-2) + fib(n-1);
You can modify it so that every time it is called it increments a counter as a side effect:
counter = ref 0;
fun fib 0 = (counter := !counter + 1; 0)
| fib 1 = (counter := !counter + 1; 1)
| fib n = (counter := !counter + 1; fib(n-2) + fib(n-1));
You can use this directly or wrap it up a bit:
fun fibonacci n = (
counter :=0;
let val v = fib n
in
(!counter,v)
end);
With a typical run:
- fibonacci 30;
val it = (2692537,832040) : int * int
(Which, by the way, shows why this version of the Fibonacci recursion isn't very good!)
I am stuck on my quicksort program. I need to count the total number of times the sorting function calls itself.
procedure quick (first, last, counter: integer);
var i, k, x : integer;
begin
i := first;
k := last;
x := a[(i+k) div 2];
counter := counter + 1;
while i<=k do begin
while a[i] < x do
i:= i+1;
while a[k] > x do
k:= k-1;
if i<=k then begin
prohod(i,k);
i:=i+1;
k:=k-1;
end;
end;
if first<k then quick(first,k, counter);
if i<last then quick(i,last, counter);
P:= P + counter;
end;
I tried this, where P is global variable and counter is recursive variable, first called as 1 ( quick(1, n, 1) ) . Sadly did not work. I also set P:= 0; right before I called the sorting (quick) procedure (I am not quite sure if it is correct way to approach the problem but it's all I could come up with).
Any ideas how to make this correctly and / or why my counter is not working?
This looks overly complex. If you just remove the counter, initialize P with the value -1 (instead of 0) and replace P := P + counter with P := P + 1, it should work.