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;
Related
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.
i'm trying to sort TStringList of integers from a text file with Insertion and Selection Sort .Selection Sort works ok , but the Insertion Sort doesnt work with my code . Can someone tell me where i'm wrong ? My 'numbers.txt' has 5000 lines of numbers. Thanks in advance
UPDATE : I have edited my code a bit , it works now with Insertion-Sort but it sorts just 4 indexes of integer as on the image
var
i, Position, n: integer;
Value: string;
begin
n := Items.Count;
for i := 1 to n - 1 do
begin
Value := Items[i];
Position := i-1;
while (Position >0) and (Items[Position]>Value) do
begin
Items[Position+1]:= Items[Position] ;
Position := Position -1 ;
end;
Items[Position+1] := Value;
end;
end;
Your data in the image is sorting exactly as it should, because you're sorting on string values, and based on the comparison you're making the order is perfect. "1143" falls exactly between the string values "11413" and "11443", because the comparison is made character by character out to the length of the shortest of the values. "1141" < "1143" < "1144", based on the first four characters of each string.
If you want an actual integer sort, then you need to convert the two values to integer before comparing them. Something like this should work (note I did not test your overall sort logic - I just used values that demonstrate the concept):
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, System.Classes;
var
i, Position, n: integer;
Value: integer;
Items: TStringList;
begin
Items := TStringList.Create;
try
Items.DelimitedText := '1116,11170,11178,11206,1122,11221,11228';
n := Items.Count;
for i := 1 to n - 1 do
begin
Value := StrToInt(Items[i]);
Position := i - 1;
while (Position > 0) and (StrToInt(Items[Position]) > Value) do
begin
Items[Position + 1]:= Items[Position];
Position := Position - 1 ;
end;
Items[Position+1] := IntToStr(Value);
end;
for i := 0 to Items.Count - 1 do
WriteLn(Items[i]);
finally
Items.Free;
end;
ReadLn;
end.
The output I got from the code above in a console window:
1116
1122
11170
11178
11206
11221
11228
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.
I'm trying to create a Tally Chart based on values stored in array.
I know it is possible to do this in Python, but is there a way to do this in Pascal by keeping the amount of coding to a minimum?
var numbers:array [0..9] of integer;
Sum,aNumber, count,count2:integer;
Average:real=0;
begin
randomize;
// Put 10 Random numbers into an array
for count:= 0 to 9 do
begin
aNumber:=Random(10)+1;
numbers[count]:=aNumber
end;
// Show a Tally
begin
for count:= 0 to 9 do
writeln(numbers[count] * '£');
writeln;
end;
readln;
end.
I simply want to present the outcome of the array by showing all possible values. E.g. If my array had the following random values between 1 and 10: 3,3,8,8,9 it should show:
1-
2-
3- II
4-
..
8- II
9- I
10-
Thanks.
The obvious way would be another for loop:
for count := 0 to 9 do
begin
for i := 1 to numbers[count] do
write('£');
writeln;
end
If you can settle for just one character at the right position, you could use something like:
for count := 0 to 9 do
writeln('£' : numbers[count]);
Think it works now... i created a Function to return the number of instances in each element. That result helps me to know the no. of iterations for each number.
Function TallyCount(x:integer):integer;
var i,TotalCount:integer;
begin
i:=0;
TotalCount:=0;
for i := 0 to 9 do
begin
if numbers[i] = x then
TotalCount:=TotalCount +1;
end;
result:=Totalcount;
end;
I have a program which outputs 3 (4x4) matrixes (different number, same layout)
And I must output again matrix, which element number sum are the biggest.
For example 65 is the most biggest elements number sum.
1 2 3 4 10 1 2 3 4 10 1 1 1 1 4
5 6 7 8 26 2 3 4 5 14 2 2 2 2 8
9 1 2 3 15 3 4 5 6 18 3 3 3 3 12
2 3 4 5 14 4 5 6 7 22 4 4 4 4 16
65 64 40
The program which generates 3 random matrixes:
uses
SysUtils;
var
i: integer;
x: integer;
y: integer;
matrix: array[1..4, 1..4] of integer;
begin
randomize;
for i := 1 to 3 do
begin
for x := 1 to 4 do
for y := 1 to 4 do
matrix[x, y] := random(101);
for x := 1 to 4 do
begin
for y := 1 to 4 do
write(IntToStr(matrix[x, y]), ' ');
writeln;
end;
writeln;
end;
readln;
end.
Can You help me? I would be very thankful.
Could be this way for instance:
program Project1;
uses
SysUtils;
// create a type for the matrix
type
TMatrix = array[1..4, 1..4] of Integer;
var
I: Integer;
X: Integer;
Y: Integer;
CurSum: Integer;
MaxIdx: Integer;
MaxSum: Integer;
Matrices: array[1..3] of TMatrix;
begin
// initialize random seed
Randomize;
// initialize max. sum matrix index and max. matrix sum
MaxIdx := 0;
MaxSum := 0;
// iterate to create 3 matrices
for I := 1 to 3 do
begin
// initialize sum value of this matrix to 0
CurSum := 0;
// iterate to fill the matrices with random values
for X := 1 to 4 do
for Y := 1 to 4 do
begin
// to the matrix I assign a random value to the X, Y position
Matrices[I][X, Y] := Random(101);
// add this random value to the current matrix sum value
CurSum := CurSum + Matrices[I][X, Y];
end;
// check if this matrix sum value is greater than the stored one
// and if so, then...
if CurSum > MaxSum then
begin
// store this matrix index
MaxIdx := I;
// and store this matrix sum as a max sum value
MaxSum := CurSum;
end;
// print out this matrix
for X := 1 to 4 do
begin
for Y := 1 to 4 do
Write(IntToStr(Matrices[I][X, Y]), ' ');
WriteLn;
end;
WriteLn;
end;
// print out the index of the matrix with max sum and its sum value
WriteLn;
WriteLn('The biggest matrix is the ' + IntToStr(MaxIdx) + '. one. The sum ' +
'of this matrix is ' + IntToStr(MaxSum) + '.');
WriteLn;
// and print out that matrix with max sum value
for X := 1 to 4 do
begin
for Y := 1 to 4 do
Write(IntToStr(Matrices[MaxIdx][X, Y]), ' ');
WriteLn;
end;
ReadLn;
end.