Pascal print numbers alternately - pascal

I have a task to print each number from the input alternately, firstly numbers with even indexes, then numbers with odd indexes. I have solved it, but only for one line of numbers, but I have to read n lines of numbers.
Expected input:
2
3 5 7 2
4 2 1 4 3
Expected output:
7 5 2
1 3 2 4
Where 2 is number of lines, 3 and 4 are numbers of numbers, 5, 7, 2 and 2, 1 , 4, 3 are these numbers.
Program numbers;
Uses crt;
var k,n,x,i,j: integer;
var tab : Array[1..1000] of integer;
var tab1 : Array[1..1000] of integer;
var tab2 : Array[1..1000] of integer;
begin
clrscr;
readln(k);
for i:=1 to k do
begin
read(n);
for j:=1 to n do
begin
read(tab[j]);
if(j mod 2 = 0) then
tab1[j]:=tab[j]
else
begin
tab2[j]:=tab[j];
end;
end;
end;
for j:=1 to n do
if tab1[j]<>0 then write(tab1[j], ' ');
for j:=1 to n do
if tab2[j]<>0 then write(tab2[j], ' ');
end.

Let's clean up the formatting, and use a record to keep track of each "line" of input.
program numbers;
uses
crt;
type
TLine = record
count : integer;
numbers : array[1..1000] of integer
end;
var
numLines, i, j : integer;
lines : Array[1..1000] of TLine;
begin
clrscr;
readln(numLines);
for i := 1 to numLines do
begin
read(lines[i].count);
for j := 1 to lines[i].count do
read(lines[i].numbers[j])
end
end.
We can read each line in. Now, how do we print the odd and even indices together? Well, we could do math on each index, or we could just increment by 2 instead of 1 using a while loop.
program numbers;
uses
crt;
type
TLine = record
count : integer;
numbers : array[1..1000] of integer
end;
var
numLines, i, j : integer;
lines : Array[1..1000] of TLine;
begin
clrscr;
readln(numLines);
// Read in lines.
for i := 1 to numLines do
begin
read(lines[i].count);
for j := 1 to lines[i].count do
read(lines[i].numbers[j])
end;
// Print out lines.
for i := 1 to numLines do
begin
j := 1;
while j <= lines[i].count do
begin
write(lines[i].numbers[j], ' ');
j := j + 2
end;
j := 2;
while j <= lines[i].count do
begin
write(lines[i].numbers[j], ' ');
j := j + 2
end;
writeln
end
end.
Now if we run this:
2
3 4 5 6
4 6 2 4 1
4 6 5
6 4 2 1
One thing we can note is that the following loop is the same for both odd and even indexes, except for the start index.
while j <= lines[i].count do
begin
write(lines[i].numbers[j], ' ');
j := j + 2
end;
This is a perfect place to use a procedure. Let's call it PrintEveryOther and have it take an index to start from and a line to print.
program numbers;
uses
crt;
type
TLine = record
count : integer;
numbers : array[1..1000] of integer
end;
var
numLines, i, j : integer;
lines : Array[1..1000] of TLine;
procedure PrintEveryOther(start : integer; line :TLine);
var
i : integer;
begin
i := start;
while i <= line.count do
begin
write(line.numbers[i], ' ');
i := i + 2
end
end;
begin
clrscr;
readln(numLines);
for i := 1 to numLines do
begin
read(lines[i].count);
for j := 1 to lines[i].count do
read(lines[i].numbers[j])
end;
for i := 1 to numLines do
begin
PrintEveryOther(1, lines[i]);
PrintEveryOther(2, lines[i]);
writeln
end
end.

Related

Pascal bubble sort print each sorted line

I have my bubble sorting algorithm which works correctly but I want to set it up so it prints each line in the process of the final output(19 lines).I have tried almost everything, but it doesn't print correctly:
program Bubble_Sort;
const N = 20;
var
d : array[1..N] of integer;
var
i,j,x : integer;
begin
randomize;
for i := 1 to N do d[i] := random(100);
writeln('Before sorting:'); writeln;
for i := 1 to N do write(d[i], ' ');
writeln;
for j := 1 to N - 1 do
for i := 1 to N - 1 do
write(d[i], ' ');
if d[i] > d[i+1] then
begin
x := d[i]; d[i] := d[i+1]; d[i+1] := x;
end;
writeln('After sorting:'); writeln;
for i := 1 to N do write(d[i], ' ');
writeln;
end.
The outer loop in the center of your code, the for j ... loop runs for each bubble iteration. That is where you want to output the state of the sorting. Because you thus have more than one statement within that for j ... loop, you must also add a begin .. end pair:
for j := 1 to N - 1 do
begin
//one round of sorting
//display result so far
end;
The sorting is ok as you have it, except when you added the write(d[i], ' '); presumably to output the sort result for one iteration, you changed the execution order to become totally wrong.
Remove the write(d[i], ' '); from where it is now.
To display the sorting result after each iteration add a new for k ... loop and a writeln;
for k := 1 to N do
write(d[k], ' ');
writeln;
Final sorting and progress display should be structured like:
for j := 1 to N - 1 do
begin
for i := 1 to N - 1 do
// one round of sorting
for k := 1 to N - 1 do
// output result of one sorting round
end;

Read integers from a string

I'm learning algorithms and I'm trying to make an algorithm that extracts numbers lets say n in [1..100] from a string. Hopefully I get an easier algorithm.
I tried the following :
procedure ReadQuery(var t : tab); // t is an array of Integer.
var
x,v,e : Integer;
inputs : String;
begin
//readln(inputs);
inputs:='1 2 3';
j:= 1;
// make sure that there is one space between two integers
repeat
x:= pos(' ', inputs); // position of the space
delete(inputs, x, 1)
until (x = 0);
x:= pos(' ', inputs); // position of the space
while x <> 0 do
begin
x:= pos(' ', inputs); //(1) '1_2_3' (2) '2_3'
val(copy(inputs, 1, x-1), v, e); // v = value | e = error pos
t[j]:=v;
delete(inputs, 1, x); //(1) '2_3' (2) '3'
j:=j+1; //(1) j = 2 (2) j = 3
//writeln(v);
end;
//j:=j+1; // <--- The mistake were simply here.
val(inputs, v, e);
t[j]:=v;
//writeln(v);
end;
I get this result ( resolved ) :
1
2
0
3
expected :
1
2
3
PS : I'm not very advanced, so excuse me for reducing you to basics.
Thanks for everyone who is trying to share knowledge.
Your code is rather inefficient and it also doesn't work for strings containing numbers in general.
A standard and performant approach would be like this:
type
TIntArr = array of Integer;
function GetNumbers(const S: string): TIntArr;
const
AllocStep = 1024;
Digits = ['0'..'9'];
var
i: Integer;
InNumber: Boolean;
NumStartPos: Integer;
NumCount: Integer;
procedure Add(Value: Integer);
begin
if NumCount = Length(Result) then
SetLength(Result, Length(Result) + AllocStep);
Result[NumCount] := Value;
Inc(NumCount);
end;
begin
InNumber := False;
NumCount := 0;
for i := 1 to S.Length do
if not InNumber then
begin
if S[i] in Digits then
begin
NumStartPos := i;
InNumber := True;
end;
end
else
begin
if not (S[i] in Digits) then
begin
Add(StrToInt(Copy(S, NumStartPos, i - NumStartPos)));
InNumber := False;
end;
end;
if InNumber then
Add(StrToInt(Copy(S, NumStartPos)));
SetLength(Result, NumCount);
end;
This code is intentionally written in a somewhat old-fashioned Pascal way. If you are using a modern version of Delphi, you wouldn't write it like this. (Instead, you'd use a TList<Integer> and make a few other adjustments.)
Try with the following inputs:
521 cats, 432 dogs, and 1487 rabbits
1 2 3 4 5000 star 6000
alpha1beta2gamma3delta
a1024b2048cdef32
a1b2c3
32h50s
5020
012 123!
horses
(empty string)
Make sure you fully understand the algorithm! Run it on paper a few times, line by line.

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)

Read symbols from from the text file?

10
Balta B 1 15
Melyna M 2 15
Zalia Z 3 12
Raduona R 4 10
Geltona G 5 10
Violetine V 6 12
Pilka P 7 10
Oranzine O 8 12
Alyvuogiu A 9 12
Juoda J 10 10
3 5
Andrius B 4 P 7 R 4 B 1 V 6
Tomas V 6 A 9 B 6 O 8 P 2
Evelina R 4 P 7 R 4 P 7 B 1
program Spalvotos_korteles;
type Spalvos = record
SPav : string[15]; // SpalvosPavadinimas
SNr, SSk : integer; // SpalvosNumeris, SpalvosSkaicius
SI : char; // SpalvuIndeksas
end;
Mokiniai = record
V : string[15]; // Mokinio vardas
MI : char; // Mokinio istrauktas indeksas
Mnr, TR, NR : integer; // Mokinio uzrasytas numeris TeisingiRasymai, NeteisingiRasymai
end;
Mas = array[1..100] of Spalvos;
Mas1 = array[1..100] of Mokiniai;
Mas2 = array[1..100] of char;
Mas3 = array[1..100] of integer;
var n, Q, MokSk, MokT : integer;
S : Mas;
M : Mas1;
VI : Mas2; // Visi Indeksai
VNr, Istraukta, TeisingiRasymai, Nepanaudota : Mas3; // VNr - Visi Numeriai
procedure Nuskaitymas;
var df : text;
Qq, i, j, z, ii : integer;
begin
Qq:=1;
assign(df,'duom.txt');
reset(df);
readln(df, n);
for i:= 1 to n do
readln(df, S[i].SPav, S[i].SI, S[i].SNr, S[i].SSk);
readln(df, MokSk, MokT);
for j := 1 to MokSk do
begin
read(df,M[j].V);
for z := 1 to MokT do
begin
read(df, M[z].MI, M[z].Mnr);
VI[Qq] := M[z].MI;
VNr[Qq] := M[z].Mnr;
Qq:=Qq+1;
for ii := 1 to n do
if (M[z].MI = S[ii].SI) and (M[z].Mnr = S[ii].SNr) then M[j].TR := M[j].TR+1;
end;
end;
Q:=Qq-1;
close(df);
end;
procedure Uzrasymai_ant_korteliu;
var i, j : integer;
begin
for i:= 1 to n do
begin
for j:= 1 to Q do
begin
if S[i].SI = VI[j] then
Istraukta[i]:=Istraukta[i]+1;
if (S[i].SI = VI[j]) and (S[i].SNr = VNr[j]) then
TeisingiRasymai[i]:= TeisingiRasymai[i]+1;
end;
Nepanaudota[i]:= S[i].SSk - Istraukta[i];
end;
end;
procedure Rezultatas;
var i, j : integer;
Rf : text;
begin
assign(rf,'SpalvuRezultas.Txt');
rewrite(rf);
for i := 1 to MokSk do
writeln(rf,M[i].V, M[i].TR);
writeln(rf);
for j := 1 to n do
writeln(rf,S[j].SPav, Istraukta[j], TeisingiRasymai[j], Nepanaudota[j]);
close(rf);
end;
begin
Nuskaitymas;
Uzrasymai_ant_korteliu;
Rezultatas;
end.
My goal is to read the 3 last roads and look how many numbers by the symbols are correct (the correct ones are symbol & first number from the columns) but when I try to read then I get the 106error wrong numeric format. I somehow understand that the problem because of the char symbols but I have no clue how to fix it. Could someone help me?
The main idea is to find out how the program interprets your read statement in your program.
Let ch, ch1, ch2 ... be a char and int, int1, int2 ... be an integer.
INPUT:
P 1 C 2
execute read(ch, int)
RESULT:
ch = P
int = 1
It works perfectly ok.
Let's expand this to read four elements.
INPUT:
P 1 C 2
execute read(ch1, int1, ch2, int2)
RESULT:
ch1 = P
int1 = 1
ch2 = C
int2 = 2
However,
INPUT:
P 1 C 2
execute read(ch1, int1); read(ch2, int2);
RESULT:
ch1 = P
int1 = 1
ERROR 106 when execute read(ch2, int2);
Why?
Let's see the following illustration.
reading ch1
1234567
P 1 C 2
^
The first read(ch1, int1) asks the program to read a char and then a integer, separated by SPACE. The program first read a char and move the pointer to position 2 and then knows it is a SPACE so move on read the next int which move the pointer to position 3.
reading int1
1234567
P 1 C 2
^
So it reads 1 into int1. And move the pointer to the next position. Then the first read is finished.
1234567
P 1 C 2
^
What's going on? Second read will read the char on position 4 which is a SPACE. It won't give out any warning as it is really a character. After that the position of pointer should be on position 5.
1234567
P 1 C 2
^
The program will not skip position 5 as it is not a SPACE. Therefore, 'C' is read into int2. As 'C' is not an integer, the program gives out a RUNTIME ERROR 106.
It seems that readln(df, S[i].SPav, S[i].SI, S[i].SNr, S[i].SSk); and read(df,M[j].V);read(df, M[z].MI, M[z].Mnr); have the same logic, but in the execution, they do not.
Moreover, you have to go to the next line after you have read all elements on a row by readln(df);.
FYI, below is the edited code:
program post;
type
Spalvos = record
SPav: string[15]; // SpalvosPavadinimas
SNr, SSk: integer; // SpalvosNumeris, SpalvosSkaicius
SI: char; // SpalvuIndeksas
end;
Mokiniai = record
V: string[15]; // Mokinio vardas
MI: char; // Mokinio istrauktas indeksas
Mnr, TR, NR: integer;
// Mokinio uzrasytas numeris TeisingiRasymai, NeteisingiRasymai
end;
Mas = array[1..100] of Spalvos;
Mas1 = array[1..100] of Mokiniai;
Mas2 = array[1..100] of char;
Mas3 = array[1..100] of integer;
var
n, Q, MokSk, MokT: integer;
S: Mas;
M: Mas1;
VI: Mas2; // Visi Indeksai
VNr, Istraukta, TeisingiRasymai, Nepanaudota: Mas3; // VNr - Visi Numeriai
temp: char;
procedure Nuskaitymas;
var
df: Text;
Qq, i, j, z, ii: integer;
begin
Qq := 1;
Assign(df, 'duom.txt');
reset(df);
readln(df, n);
for i := 1 to n do
readln(df, S[i].SPav, S[i].SI, S[i].SNr, S[i].SSk);
readln(df, MokSk, MokT);
for j := 1 to MokSk do
begin
Read(df, M[j].V);
for z := 1 to MokT do
begin
Read(df, M[z].MI, M[z].Mnr, temp);
writeln(M[z].MI, M[z].Mnr);
VI[Qq] := M[z].MI;
VNr[Qq] := M[z].Mnr;
Qq := Qq + 1;
for ii := 1 to n do
if (M[z].MI = S[ii].SI) and (M[z].Mnr = S[ii].SNr) then
M[j].TR := M[j].TR + 1;
end;
readln(df);
end;
Q := Qq - 1;
Close(df);
end;
procedure Uzrasymai_ant_korteliu;
var
i, j: integer;
begin
for i := 1 to n do
begin
for j := 1 to Q do
begin
if S[i].SI = VI[j] then
Istraukta[i] := Istraukta[i] + 1;
if (S[i].SI = VI[j]) and (S[i].SNr = VNr[j]) then
TeisingiRasymai[i] := TeisingiRasymai[i] + 1;
end;
Nepanaudota[i] := S[i].SSk - Istraukta[i];
end;
end;
procedure Rezultatas;
var
i, j: integer;
Rf: Text;
begin
Assign(rf, 'SpalvuRezultas.Txt');
rewrite(rf);
for i := 1 to MokSk do
writeln(rf, M[i].V, M[i].TR);
writeln(rf);
for j := 1 to n do
writeln(rf, S[j].SPav, Istraukta[j], TeisingiRasymai[j], Nepanaudota[j]);
Close(rf);
end;
begin
Nuskaitymas;
Uzrasymai_ant_korteliu;
Rezultatas;
end.
Thank you for your answer, but I already found out about char reading spaces too and I fixed it. Don't know if it is the best way but it works.
readln(df, MokSk, MokT);
for j := 1 to MokSk do
begin
read(df,M[j].V);
for z := 1 to MokT-1 do
begin
read(df, MI, Mnr, Tuscias); // M[z].MI P M[z].Mnr O
VI[Qq] := MI;
VNr[Qq] := Mnr;
Qq:=Qq+1;
for ii := 1 to n do
if (MI = S[ii].SI) and (Mnr = S[ii].SNr) then M[j].TR := M[j].TR+1;
end;
read(df, MI, Mnr);
VI[Qq] := MI;
VNr[Qq] := Mnr;
Qq:=Qq+1;
for ii := 1 to n do
if (MI = S[ii].SI) and (Mnr = S[ii].SNr) then M[j].TR := M[j].TR+1;
readln(df);
end;
Andrius B 4 P 7 R 4 B 1 V 6
Tomas V 6 A 9 B 6 O 8 P 2
Evelina R 4 P 7 R 4 P 7 B 1
I don't know any other way to read this program, so I made it like this.
P.s. I tried your way before but it didn't work because after the last pair there's no space and the program makes an error out of it. But thanks for your help kind sir :)

Magic Square FreePascal

Program must output whether the square is magic square or not.
I must read square from file.
Magic square - all rows, all columns and both diagonals sum must be equal.
Program shows right answer, but these 16 numbers must be read from text file.
Text file is looking like:
1 1 1 1
2 2 2 2
3 3 3 3
4 4 4 4
Program itself:
var
m:array[1..4,1..4] of integer;
i:byte;
j:byte;
r1,r2,r3,r4,c1,c2,c3,c4,d1,d2:integer;
begin
for i:=1 to 4 do
for j:=1 to 4 do
begin
write('Enter value for column=',i,' row=',j,' :');
readln(m[i,j]);
end;
r1:=m[1,1]+m[1,2]+m[1,3]+m[1,4];
r2:=m[2,1]+m[2,2]+m[2,3]+m[2,4];
r3:=m[3,1]+m[3,2]+m[3,3]+m[3,4];
r4:=m[4,1]+m[4,2]+m[4,3]+m[4,4];
c1:=m[1,1]+m[2,1]+m[3,1]+m[4,1];
c2:=m[1,2]+m[2,2]+m[3,2]+m[4,2];
c3:=m[1,3]+m[2,3]+m[3,3]+m[4,3];
c4:=m[1,4]+m[2,4]+m[3,4]+m[4,4];
d1:=m[1,1]+m[2,2]+m[3,3]+m[4,4];
d2:=m[1,4]+m[2,3]+m[3,2]+m[4,1];
if (r1=r2) and (r2=r3) and (r3=r4) and (r4=c1) and (c1=c2) and (c2=c3) and (c3=c4) and (c4=d1) and (d1=d2) then
begin
write('Magic Square');
end
else
begin
write('Not Magic Square');
end;
readln;
end.
Here is a procedure to read the matrix from a text file.
The row elements are supposed to be separated with space.
type
TMatrix = array[1..4,1..4] of integer;
procedure ReadMatrix( const filename: String; var M: TMatrix);
var
i,j : integer;
aFile,aLine : TStringList;
begin
aFile := TStringList.Create;
aLine := TStringList.Create;
aLine.Delimiter := ' ';
try
aFile.LoadFromFile(filename);
Assert(aFile.Count = 4,'Not 4 rows in TMatrix');
for i := 0 to 3 do
begin
aLine.DelimitedText := aFile[i];
Assert(aLine.Count = 4,'Not 4 columns in TMatrix');
for j := 0 to 3 do
M[i+1,j+1] := StrToInt(aLine[j]);
end;
finally
aLine.Free;
aFile.Free;
end;
end;

Resources