In this program when I try to put the code blocks [1] and [2] in procedures they don't work properly when calling them, and when I keep them in the main program only the first one works properly and the second doesn't and when I comment out the first one the second one works as it's supposed...can you please spot the error, I think it's with getting the files names from the user cause when I choose the file's name it works properly
program Linked_lists_files;
type
Node = ^T;
T = record
num : integer;
next : Node;
End;
var
File1 : Text;
N, i, j, cmp, y, x, Num, matrixvalue : integer;
Head, Tail, Head2, Tail2, Head3, Tail3 : Node;
s : string;
matrix : array [1..20, 1..20] of Integer;
// procedures
// [1]
Procedure fillFile();
Begin
write('Input file name to create : ');
readln(s);
assign(File1,s);
rewrite(File1);
Repeat
write('Enter a number : ');
readln(N);
if (N>=0) then
writeln(File1, N);
Until (N<0);
close(File1);
End;
// [2]
Procedure GetFromFile();
Begin
cmp := 0;
write('Enter file name to read from : ');
readln(s);
assign(File1, s);
reset(File1);
while not eof(File1) Do
Begin
readln(File1, N);
if (Head = Nil) then
Begin
new(Head);
Tail := Head;
End
Else
Begin
new(Tail^.next);
Tail := Tail^.next;
End;
Tail^.num := N;
Tail^.next := Nil;
cmp := cmp + 1;
End;
Close(File1);
Write('Elements of the list : ');
Tail := Head;
if (Head<>nil) then
Begin
while(Tail <> nil) Do
Begin
write('[',Tail^.num,']', ' ');
Tail := Tail^.next;
End;
End
Else
Writeln('[!] The list is empty');
writeln;
writeln('Number of elements in the list : ', cmp);
End;
// [3]
Procedure SaveFromFile();
Begin
Head := Nil;
write('Enter file name to read from : '); readln(s);
writeln('[+] Fill in your list');
Repeat
write('+ Enter an integer : ');
read(y);
if (y>=0) then
Begin
if (Head = Nil) then
Begin
new(Head);
Tail := Head;
End
Else
Begin
new(Tail^.next);
Tail := Tail^.next;
End;
Tail^.num := y;
Tail^.next := Nil;
End;
Until y<0;
assign(File1, s);
rewrite(File1);
Tail := Head;
while(Tail <> nil) Do
Begin
Num := Tail^.num;
Tail := Tail^.next;
Writeln(File1, Num);
End;
Close(File1);
Writeln('[+] Elements of the lists have been successfully added to the new file');
End;
// [4]
Procedure SquareMatrix();
Begin
cmp := 0;
x := 0;
writeln('[+] Fill in your list');
Repeat
write('+ Enter an integer : ');
read(y);
if (y>=0) then
Begin
if (Head3 = Nil) then
Begin
new(Head3);
Tail3 := Head3;
End
Else
Begin
new(Tail3^.next);
Tail3 := Tail3^.next;
End;
Tail3^.num := y;
Tail3^.next := Nil;
cmp := cmp + 1;
End;
Until y<0;
while (cmp<>1) Do
Begin
if (cmp mod 2 <> 0) and (cmp <> 1) then
x := x + 1;
cmp := cmp div 2;
End;
if (x>0) then
writeln('[-] False')
Else
writeln('[+]True');
End;
// [5]
Procedure ElementsOfSM();
Begin
cmp := 0;
x := 0;
writeln('[+] Fill in your list');
Repeat
write('+ Enter an integer : ');
read(y);
if (y>=0) then
Begin
if (Head = Nil) then
Begin
new(Head);
Tail := Head;
End
Else
Begin
new(Tail^.next);
Tail := Tail^.next;
End;
Tail^.num := y;
Tail^.next := Nil;
cmp := cmp + 1;
End;
Until y<0;
Tail := Head;
i := 1;
j := 1;
while(Tail <> nil) Do
Begin
matrixvalue := Tail^.num;
matrix[i,j] := matrixvalue;
Tail := Tail^.next;
j := j + 1;
if (j = sqrt(cmp)+1) then
Begin
i := i + 1;
j := 1;
End;
End;
for i:=1 to cmp Do
for j:=1 to cmp Do
Begin
if (matrix[i,j]<>0) then
writeln('[',matrix[i,j],']',' : ','[',i,',',j,']');
End;
End;
// [6]
Procedure Element();
Begin
write('Enter the number of the line : ');
read(i);
write('Enter the number of the column : ');
read(j);
write('The element corresponding to ','[',i,',',j,'] is : ','[',matrix[i,j],']');
writeln;
End;
// [7]
Procedure WriteP();
Begin
write('Enter the number of the line : ');
read(i);
write('Enter the number of the column : ');
read(j);
write('Enter the value you want to pass in : ');
read(N);
matrix[i,j] := N;
writeln('The new matrix');
for i:=1 to cmp Do
for j:=1 to cmp Do
Begin
if (matrix[i,j]<>0) then
writeln('[',matrix[i,j],']',' : ','[',i,',',j,']');
End;
writeln;
End;
// [8]
Procedure Content();
Begin
write('Enter the number of the line : ');
read(i);
write('Enter the number of the column : ');
read(j);
writeln('The value stored inn this cell is : ','[', matrix[i,j],']');
End;
// Start of main program
Begin
Head := Nil;
Repeat
writeln('*********** MENU ***********');
writeln('[1] fillFile');
writeln('[2] GetFromFile');
writeln('[3] SaveFromFile');
writeln('[4] SquareMatrix');
writeln('[5] ElementsOfSM');
writeln('[6] Element');
writeln('[7] WriteP');
writeln('[8] Content');
writeln('*********** End ***********');
write('Choose one : ');
read(N);
case N of
1 : fillFile();
2 : GetFromFile();
3 : SaveFromFile();
4 : SquareMatrix();
5 : ElementsOfSM();
6 : Element();
7 : WriteP();
8 : Content();
End;
Until (N<>1) and (N<>2) and (N<>3) and (N<>4) and (N<>5) and (N<>6) and (N<>7) and (N<>8) and (N<>9);
End.
The problem you describe is being caused by the known behaviour of the Read statement; basically, the second (and subsequent) times you call it, it returns immediately, without waiting for any keyboard input and without reading anything.
This happen because FPC is closely based on Object Pacal in the commercial Delphi development package, and in Delphi's case, this is the officially documented behaviour.
From the Delphi (v7) online help:
Delphi syntax:
Text files:
procedure Read( [ var F: Text; ] V1 [, V2,...,Vn ] );
Description
The Read procedure can be used in Delphi code in the following ways.
[...]
With a type string variable:
Read reads all characters up to, but not including, the next end-of-line
marker or until Eof(F) becomes true; it does not skip to the next line after reading. If the resulting string is longer than the maximum length of the string variable, it is truncated.
After the first Read, each subsequent Read sees the end-of-line marker and returns a zero-length string (emphasis added).
Use multiple Readln calls to read successive string values.
Fortunately, the solution is simple, use readln, instead of read, as in
readln(s);
Update Make sure you replace all instances of read by readln, as you have left a number of them unchanged, as #TomBrunberg has commented.
After that, run your code again and select 1 from the menu and you will find that fillFile executes, but the program terminates on the until ... line. And that's because it is a very bad idea to use the same global variable, in this case N for several different purposes throughout the program. So, you should edit your code further (and carefully) so that as far as possible it only uses global variables for global purposes. Turn all all the other variables into local variables, preferably with different names than the global ones. If after that you are still having problems, submit a new question focused on that.
I've run into a bit of a wall with my sorting, I managed to sort the rows of my string grid from smallest to largest but now I'm not sure how to sort it in descending order. I've tried using the code I used from the other sort and I only changed the 2nd last loop in the code to see if I can read from the bottom of the TStringList, but it hasn't worked and only takes one row from the list and duplicates it into the rest of the rows. Is there perhaps a way to reverse read a TStringList after sorting?
Code I used for the other sort I have and tried to implement for this sort (only changed the 2nd last loop):
procedure TfrmPuntehou.SortLTSGrid(var grid: TStringGrid; columntotal: Integer);
const
separator = ',';
var
iCount,i,j,k,iPos:integer;
TheList:TStringList;
sString,sTempString:string;
m: Integer;
o: Integer;
begin
//procedure to sort from large to small values
//get row amount
iCount:=grid.RowCount-1;
//create list
TheList:=TStringList.Create;
TheList.Sorted:=False;
//start of try..finally block
try
begin
//fill the list
for i := 1 to (iCount - 1) do
begin
TheList.Add(grid.Rows[i].Strings[columntotal]+separator+grid.Rows[i].Text);
end;
//sort the list
TheList.Sort;
for k := 1 to TheList.Count do
begin
//take the line of the list and put it in a string var
sString:= TheList.Strings[(k-1)];
//get separator pos in that string
iPos:=AnsiPos(separator,sString);
sTempString:='';
//remove separator and the column text at the front of the string
sTempString:=Copy(sString,(iPos+1),Length(sString));
TheList.Strings[(k-1)]:= '';
TheList.Strings[(k-1)]:= sTempString;
end;
//fill the grid
for j:= (iCount - 1) downto 1 do
begin
for o := 1 to (iCount - 1) do
begin
grid.Rows[j].Text := TheList.Strings[(o-1)] ;
end;
end;
//fill the row numbers
for m := 1 to iCount do
begin
grid.Cells[0,m]:= IntToStr(m);
end;
end;
finally
TheList.Free;
end;
//end of try..finally block
end;
Thanks in advance for the help!Kind RegardsPrimeBeat
Use TStringList.CustomSort to sort the list using a specific method for comparison.
The specification for the comparer is given here.
Example:
function Compare1( // Normal alphanum sort
List : TStringList;
Index1 : Integer;
Index2 : Integer) : Integer;
begin
if List[Index1] = List[Index2] then
Result := 0
else if List[Index1] < List[Index2] then
Result := -1
else
Result := 1;
end;
function Compare2( // Reverse alphanum sort
List : TStringList;
Index1 : Integer;
Index2 : Integer) : Integer;
begin
if List[Index1] = List[Index2] then
Result := 0
else if List[Index1] < List[Index2] then
Result := 1
else
Result := -1;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
SList : TStringList;
S : String;
begin
SList := TStringList.Create;
try
SList.Add('Pierre');
SList.Add('Albert');
SList.Add('Paul');
SList.Add('Jean');
SList.Add('Simon');
Memo1.Lines.Add('=== Compare1 ===');
SList.CustomSort(Compare1);
for S in SList do
Memo1.Lines.Add(S);
Memo1.Lines.Add('=== Compare2 ===');
SList.CustomSort(Compare2);
for S in SList do
Memo1.Lines.Add(S);
finally
SList.Free;
end;
end;
I got this error when trying to compile.
left side cannot be assign to, ./number 21,22 in pastebin
here is my code
Program urut;
Uses Wincrt;
Const N = 5;
data: Array [1..N] Of Integer = (2,4,5,3,1);
Var
j,k,temp : Integer;
Begin
Clrscr;
Writeln ('Data sebelum diurutkan');
For j:=1 To N Do
Begin
Writeln('data[' ,j, ']= ',data [j]);
End;
For j:=1 To N-1 Do
Begin
For k :=N Downto j+1 Do
Begin
If data[k] < data[k-1] Then
Begin
temp := data[k];
data[k] := data[k-1]; //left side cannot be assigned to
data[k-1] := temp; //left side cannot be assigned to
End;
End;
End;
Writeln;
Writeln ('Data setelah diurutkan ');
For j:=1 To N Do
Begin
Writeln ('data[' ,j, '] = ',data[j]);
End;
Writeln;
End.
sorry for uncorrectly pattern post
, thank you so much.
Like tom Tom Brunberg says, my array is const, it can't be changed. Therefore I need to remove that const.
So it should be
data: Array [1..5] Of Integer = (value);
without const, and put it under var with another variable
I am going to write a program that asks the user to enter items then choose the sorting type to sort them (bubble, inserion and selection).
After that I have to compare these types by time efficiency.
I wrote code for the first part, but I didn't know how to use a function in Pascal to write the second part (comparison).
This is what I have done:
Begin
writeln('How many Number you would like to sort:');
readln(size);
For m := 1 to size do
Begin
if m=1 then
begin
writeln('');
writeln('Input the first value: ');
readln(IntArray[m]);
end
else if m=size then
begin
writeln('Input the last value: ');
readln(IntArray[m]);
end
else
begin
writeln('Input the next value: ');
readln(IntArray[m]);
End;
End;
writeln('Values Before The Sort: ');
for m:=0 to size-1 do
writeln(IntArray[m+1]);
writeln();
begin
repeat
writeln(' ~*~...~*~ ~*~...~*~ ~*~...~*~ ~*~...~*~');
writeln('1. Insertion Sort.');
writeln('2. Bubble Sort.');
writeln('3. Selection Sort. ');
writeln('4. Exist ');
writeln('');
writeln('Enter your choice number: ');
readln(sort);
case sort of
1: begin {when choice = 1}
writeln('');
writeln(' The sorted numbers by Insertion sort are ~> ');
For i := 2 to size do
Begin
index := intarray[i];
j := i;
While ((j > 1) AND (intarray[j-1] > index)) do
Begin
intarray[j] := intarray[j-1];
j := j - 1;
End;
intarray[j] := index;
End;
for i:= 1 to size do
writeln(intarray[i]);
end;
2: begin {when choice = 2}
writeln('');
writeln(' The sorted numbers by bubble sort are ~> ');
For i := size-1 DownTo 1 do
For j := 2 to i do
If (intArray[j-1] > intarray[j]) then
Begin
temp := intarray[j-1];
intarray[j-1] := intarray[j];
intarray[j] := temp;
End;
for i:= 1 to size do
writeln(intarray[i]);
end;
3: begin {when choice = 3}
writeln('');
writeln(' The sorted numbers by selection sort are ~> ');
for i:=1 to size do
begin
j:= i ;
for index:= i +1 to size do
if intarray[index]<intarray[j] then
j:=index;
temp:=intarray[j];
intarray[j]:=intarray[i];
intarray[i]:=temp;
end;
for i:= 1 to size do
writeln(intarray[i]);
end;
4: begin
writeln('*~...~*~ Thank U For used Our Program We Hope You Enjoyed ~*~...~*~ ');
end;
end;
until sort = 4 ;
end;
end.
I hope that I will find the answer here...
I hope you know the TIME complexity of Bubble, Insertion and Selection sort.
If you know you can just compare like that
if (time_complexity_bub>time_complexity_ins)and(time_complexity_bub>time_complexity_sel) then writeln('Bubble Sort is the WORST !!!');
if (time_complexity_ins>time_complexity_bub)and(time_complexity_ins>time_complexity_sel) then writeln('Insertion Sort is the WORST !!!');
if (time_complexity_sel>time_complexity_ins)and(time_complexity_bub<time_complexity_sel) then writeln('Selection Sort is the WORST !!!');
If you have other questions you can ask me :D ...
Pascal supports >,>=,=,<= and < for comparison, but it seems you already know this:
if intarray[index]<intarray[j] then
So maybe you have to explain your question a bit clearer.
I think author is not sure how to measure time in Pascal.
I don't know what compiler you're using, but overall pattern is like:
var
startTime : TDateTime;
overallTime : TDateTime;
begin
startTime := SomeFunctionToGetCurrentTimeWithMicroseconds;
SomeLongOperation;
overalltime := SomeFunctionToGetCurrentTimeWithMicroseconds() - startTime;
end.
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.