Get the minimum amount of degrees recorded in a day - pascal

I need to make a program that gets the minimum amount of degrees recorded in a day at what hour, I made the program, I am getting the correct hour at which the min amount of degrees were recorded but I am not getting the correct amount of degrees
Program P1;
Type
Hour = 0..23;
Degrees = -40..40;
Temperature = array [Hour] of Degrees;
var
t : Temperature;
i, min_t, max_t, hour_t_min, hour_t_max : integer;
procedure test;
begin
for i := 0 to 23 do
begin
writeln('Enter the temperature at hour ', i);
readln(t[i]);
min_t := t[0];
if min_t > t[i] then
begin
min_t := t[i];
ora_t_min := i;
end;
if max_t < t[i] then
begin
max_t := t[i];
ora_t_max := i;
end;
end;
writeln('temp min ', min_t, ' at hour ', hour_t_min);
writeln('temp max ', max_t, ' at hour ', hour_t_max);
end; {procedure}
begin { main }
test;
end.

Min_t (and max_t) should be initialized outside and before the loop.
You are assigning min_t:=t[0] in each loop, this is wrong, and max_t is not being initialized. Also, I think this is a typo, ora_t_min and ora_t_max should be changed to hour_t_min and hour_t_max:
Something like this:
min_t := 40;
max_t := -40;
for i := 0 to 23 do
begin
writeln('Enter the temperature at hour ', i);
readln(t[i]);
if min_t > t[i] then begin min_t := t[i]; hour_t_min := i; end;
if max_t < t[i] then begin max_t := t[i]; hour_t_max := i; end;
end;
writeln('temp min ', min_t, ' at hour ', hour_t_min);
writeln('temp max ', max_t, ' at hour ', hour_t_max);
end;

Related

Difference between two dates in Pascal

This program is supposed to find the difference between two dates but it has a bug and I can't find it.
It keeps returning a big number - please help
Program tp4;
Type
dt = Record
jour : Integer;
mois : Integer;
annee : Integer;
End;
Var
date : dt ;
y,x,i,s : Integer;
Begin
x := 0;
s := 0;
For y:=1 To 2 Do
//2 dates
Begin
Writeln('Entrez un date : jour mois année ');
Readln( date.jour, date.mois, date.annee);
While ((date.jour<=0) Or (date.jour>31) Or (date.mois>12) Or (date.annee<=0) ) Do
//verfication loop
Begin
Writeln('Entrez une date valide : jour mois année ');
Readln(date.jour ,date.mois ,date.annee);
End;
s := s+date.jour ;
For i:= 1 To date.mois-1 Do
Case i Of
3,5,7,8,10,12,1 : s := s+31;
4,6,9,11 : s := s +30;
2 : If ((date.annee Mod 100)=0) And ((date.annee Mod 400) = 0 ) Then //convert months to days
s := s+29
Else If date.annee Mod 4 = 0 Then
s := s+29
Else s := s+28;
End; //Convert years to days
For i:= 1 To date.annee Do
If (i Mod 100 = 0) And (i Mod 400 = 0) Then s := s+366
Else If (i Mod 4 =0) Then s := s+366
Else s := s+365;
x:=s-x ;
End;
If (x)<=0 Then
Writeln('la difference est :',-x)
Else Writeln('la difference est :',x);
Readln;
End.
**input**
12 03 2019
13 03 2019
**output**
737510
I think the error was somewhere in s and x (x:=s-x; etc.), I did refactoring:
Program tp4;
Type dt = Record
jour : Integer;
mois : Integer;
annee : Integer;
End;
Type
arrayDate = array[1..2] of dt;
Var
y,i,f,s : Integer;
arrDate: arrayDate;
function Leap (Y : Word): Boolean;
Begin
If (Y Mod 4) <> 0 Then Leap := FALSE
Else If (Y Mod 100) <> 0 Then Leap := TRUE
Else Leap := (Y Mod 400) = 0;
End;
function Lenght (date: dt) : Integer;
Begin
Lenght := 0;
Lenght := Lenght + date.jour;
For i := 1 To date.mois Do
Case i Of
3, 5, 7, 8, 10, 12, 1 : Lenght := Lenght + 31;
4, 6, 9, 11 : Lenght := Lenght + 30;
2 : If Leap (date.annee) Then Lenght := Lenght + 29 Else Lenght:= Lenght + 28;
End;
For i := 1 To date.annee Do //Convert years to days
If Leap (i) Then Lenght := Lenght + 366 Else Lenght := Lenght + 365;
End;
Begin
For y := 1 To 2 Do //2 dates
Begin Writeln ('Entrez un date : jour mois année ');
Readln (arrDate[y].jour, arrDate[y].mois, arrDate[y].annee);
While ((arrDate[y].jour <= 0)
Or (arrDate[y].jour > 31)
Or (arrDate[y].mois > 12)
Or (arrDate[y].annee <= 0)) Do //verfication loop
Begin
Writeln ('Entrez une date valide : jour mois année ');
Readln (arrDate[y].jour, arrDate[y].mois, arrDate[y].annee);
End;
End;
f := Lenght(arrDate[1]);
s := Lenght(arrDate[2]);
Writeln ('la difference est :', Abs(s - f)); // absolute |s-f|
Readln;
End.
You are using the For y ... loop to request input and to calculate number of days for each input. Within the loop, the s variable is the days counter.
The error you do is that you zero s bfore the For y ... loop and not at the beginning of the loop. Therefore, the second time you request a date, s still has the value from the first date, on top of which you then start to calculate the days for the second date.
The correction is of course to move s := 0; to the beginning of the For y ... loop,
or change the first assignment of s from
s := s + date.jour;
to
s := date.jour;
Finding the difference between two dates 6,000 years apart in a loop? And (ab)using the name of a standard function "Length"? Ouch!
Try this:
//----------------------------------------------------------------------
// Convert a date to its Julian Day Number
//----------------------------------------------------------------------
procedure cj(dd, mm, yyyy: longint; var jdn, dow: longint);
var
cj_y,
cj_c,
cj_x,
cj_y: double;
begin
if dd = 0 then
begin
jdn:= -1
dow:= -1;
end
else
begin
cj_y:= yyyy + (mm - 2.85) / 12;
cj_c:= 0.75 * trunc(cj_y * 0.01);
cj_x:= frac(cj_y);
cj_y:= trunc(cj_y);
jdn:= trunc(
trunc(
trunc(367 * cj_x) + 367 * (cj_y) -
1.75 * cj_y + dd) - cj_c) +
1721115.0;
dow:= jdn mod 7;
end;
end; {cj}
Formula as given is valid for days after 1582-10-15, a small tweak will allow dates going back to 0000-03-01.
Follow the link in https://groups.google.com/g/comp.lang.pascal.borland/c/itwgcfYpLEU which I posted in August 1998 in comp.lang.pascal.borland for explanations.

Clearing a single space from the console

I don't know how to word the title correctly but I was wondering if there is any way for me to be able to clear a single space from the console instead of clearing the entire thing just to re-write it again? for example, say I was to draw out a 3 by 3 square with the numbers counting from 1-9 all the way down, is there a way for me to change the final 9 without clearing all the prior numbers. when I clear the entire console it creates a flicker effect which is very annoying. if you want to see an example of this in code here is the thing I plan to use it on:
program randomPath;
uses crt, sysutils;
type StrMultiArray = array of array of String;
var
finishedBoard : StrMultiArray;
size, i, j : integer;
regenerate : boolean;
function generateMap(size : integer) : StrMultiArray;
var
posx, posy, choice, counter : integer;
ongoing : boolean;
board : StrMultiArray;
begin
setLength(board, size, size);
for i := 0 to (size-1) do
begin
for j := 0 to (size-1) do
begin
board[i,j] := '#';
end;
end;
posx := (size div 2);
posy := (size div 2);
board[posx,posy] := ' ';
ongoing := true;
counter := 0;
while ongoing = true do
begin
choice := random(2);
if (choice = 0) then
begin
choice := random(2);
if (choice = 0) then
begin
if (posx > 0) then
begin
posx := posx - 1;
end;
end
else
begin
if (posx < size-1) then
begin
posx := posx + 1;
end;
end;
end
else
begin
choice := random(2);
if (choice = 0) then
begin
if (posy > 0) then
begin
posy := posy - 1;
end;
end
else
begin
if (posy < size-1) then
begin
posy := posy + 1;
end;
end;
end;
counter := counter + 1;
board[posx,posy] := ' ';
if counter = (size * 12) then
begin
ongoing := false;
end;
end;
generateMap := board;
end;
procedure printBoard(board : StrMultiArray; size : integer);
begin
textColor(Cyan);
write('+');
for i := 0 to (size-1) do
begin
write('-');
end;
writeLn('+');
for i := 0 to (size-1) do
begin
textColor(Cyan);
write('|');
textColor(White);
for j := 0 to (size-1) do
begin
if (board[i,j] = '#') then
begin
textBackground(White);
end;
if (board[i,j] = '#') then
begin
textBackground(Red);
end;
//write(board[i,j]);
write(' ');
textBackground(Black);
end;
textColor(Cyan);
writeLn('|');
end;
textColor(Cyan);
write('+');
for i := 0 to (size-1) do
begin
write('-');
end;
writeLn('+');
textColor(White);
end;
procedure movePlayer(board : StrMultiArray; size : integer);
var
ongoing : boolean;
posx, posy, prevx, prevy : integer;
input : char;
begin
ongoing := true;
posx := (size div 2);
posy := (size div 2);
while (ongoing = true) do
begin
board[posx,posy] := '#';
prevx := posx;
prevy := posy;
printBoard(board, size);
input := readKey();
clrScr();
case input of
'w' :
if (posx > 0) then
begin
if (board[posx-1,posy] = ' ') then
posx := posx - 1;
end;
'a' :
if (posy > 0) then
begin
if (board[posx,posy-1] = ' ') then
posy := posy - 1;
end;
's' :
if (posx < (size-1)) then
begin
if (board[posx+1,posy] = ' ') then
posx := posx + 1;
end;
'd' :
if (posy < (size-1)) then
begin
if (board[posx,posy+1] = ' ') then
posy := posy + 1;
end;
'x' :
begin
regenerate := false;
ongoing := false;
end;
else
ongoing := false;
end;
board[prevx,prevy] := ' ';
end;
end;
begin
size := 10;
regenerate := true;
randomize;
while (regenerate = true) do
begin
finishedBoard := generateMap(size);
movePlayer(finishedBoard, size);
end;
end.
I found a useful function in Pascal that allow you to select a position in the console to move the "cursor" to from which point you can write in that location. the function is called GoToXY(). documentation can be found here: https://www.freepascal.org/docs-html/rtl/crt/gotoxy.html.

Find block number and floor by flat number

Imagine - there's a house with 80 flats. It has 4 floors and 5 blocks. Each block has 4 flats.
User is asked to input flat number and Pascal program is supposed to calculate and output flat number. This must be calculated using some kind of formula. The only tip I have is that I have to use div and mod operations.
This is how the house looks like -
So far, I've created program, that loops through all 80 flats and after each 16 flats increases block value and after each 4 blocks increases stair.
This is my code:
program project1;
var
i, floors, blocks, flats, flat, block, floor, blockCounter, floorCounter : integer;
begin
floors := 4;
blocks := 5;
flats := 80;
while true do
begin
write('Flat number: ');
read(flat);
block := 1;
floor := 1;
blockCounter := 0;
floorCounter := 0;
for i := 1 to 80 do
begin
blockCounter := blockCounter + 1;
floorCounter := floorCounter + 1;
if (floorCounter = 4) then
begin
floorCounter := 0;
floor := floor + 1;
end;
if (blockCounter > 16) then
begin
block := block + 1;
blockCounter := 0;
floorCounter := 0;
floor := 1;
end;
if (i = flat) then
begin
writeln('Flat nr. ', flat, ' is in ', floor, '. floor and in ', block, '. block!');
end;
end;
end;
end.
Is there anyone who can help me with this?
I've finally solved my problem myself.
I finally undersood how div works, so I was able to solve this.
program Maja;
var dzivoklis, kapnutelpa, stavs : integer;
begin
while true do
begin
write('Ievadi dzivokla numuru: ');
read(dzivoklis);
kapnutelpa := ((dzivoklis - 1) div 16) + 1;
stavs := (((dzivoklis - 1) mod 16) div 4) + 1;
writeln('Kapnutelpa: ', kapnutelpa);
writeln('Stavs: ', stavs);
writeln();
end;
end.

All sums of a number

I need an algorithm to print all possible sums of a number (partitions).
For example: for 5 I want to print:
1+1+1+1+1
1+1+1+2
1+1+3
1+2+2
1+4
2+3
5
I am writing my code in Pascal. So far I have this:
Program Partition;
Var
pole :Array [0..100] of integer;
n :integer;
{functions and procedures}
function Minimum(a, b :integer): integer;
Begin
if (a > b) then Minimum := b
else Minimum := a;
End;
procedure Rozloz(cislo, i :integer);
Var
j, soucet :integer;
Begin
soucet := 0;
if (cislo = 0) then
begin
for j := i - 1 downto 1 do
begin
soucet := soucet + pole[j];
if (soucet <> n) then
Write(pole[j], '+')
else Write(pole[j]);
end;
soucet := 0;
Writeln()
end
else
begin
for j := 1 to Minimum(cislo, pole[i - 1]) do
begin
pole[i] := j;
Rozloz(cislo - j, i + 1);
end;
end;
End;
{functions and procedures}
{Main program}
Begin
Read(n);
pole[0] := 101;
Rozloz(n, 1);
Readln;
End.
It works good but instead of output I want I get this:
1+1+1+1+1
2+1+1+1
2+2+1
3+1+1
3+2
4+1
5
I can't figure out how to print it in right way. Thank you for help
EDIT: changing for j:=i-1 downto 1 to for j:=1 to i-1 solves one problem. But my output is still this: (1+1+1+1+1) (2+1+1+1) (2+2+1) (3+1+1) (3+2) (4+1) (5) but it should be: (1+1+1+1+1) (1+1+1+2) (1+1+3) (1+2+2) (1+4) (2+3) (5) Main problem is with the 5th and the 6th element. They should be in the opposite order.
I won't attempt Pascal, but here is pseudocode for a solution that prints things in the order that you want.
procedure print_partition(partition);
print "("
print partition.join("+")
print ") "
procedure finish_and_print_all_partitions(partition, i, n):
for j in (i..(n/2)):
partition.append(j)
finish_and_print_all_partitions(partition, j, n-j)
partition.pop()
partition.append(n)
print_partition(partition)
partition.pop()
procedure print_all_partitions(n):
finish_and_print_all_partitions([], 1, n)

How to convert a tree recursive function ( or algorithm ) to a loop one?

I have written a recursive Tree Function in pascal ( or delphi ) but i had an 'Out of Memory' message when I ran it.
I need to turn the Calculate recursive function in this code to non-recursive function, can you tell me how please :
program testing(input, output);
type
ptr = ^tr;
tr = record
age: byte;
left, right: ptr;
end;
var
topper: ptr;
total, day: longint;
procedure mycreate(var t: ptr);
var
temp:ptr;
begin
new(temp);
temp^.age := 1;
temp^.left := nil;
temp^.right := nil;
t := temp;
end;
procedure gooneday(var t: ptr);
begin
if t^.age <> 5 then
begin
if t^.age = 2 then
mycreate(t^.left)
else if t^.age = 3 then
mycreate(t^.right);
t^.age := t^.age + 1;
total := total + 1;
end;
end;
procedure calculate(var crnt: ptr);
begin
if crnt <> nil then
begin
gooneday(crnt);
calculate(crnt^.left);
calculate(crnt^.right);
end;
end;
begin
total := 0;
mycreate(topper);
day := 0;
while total < 1000000000000 do
begin
total := 0;
day := day + 1;
calculate(topper);
end;
writeln(day);
writeln(total);
end.
Recursive functions use a stack to keep the state of the recursion.
When converting to a loop, you must actually create an explicit stack. You must push and pop elements off the stack within the loop.

Resources