Trying to get a number in the range of a (variable -2) and (variable +2).
For example, if X = 7, then i would like a random number generator that gives a value in the range 5 - 9. See below my attempt which gives me unexpected results:
var x, xRange, i,count,xLower, xhigher:integer;
begin
x:=7;
xLower:=x-2;
xHigher:=x+2;
for count:= 1 to 20 do
begin
i:=random(xHigher)+xLower;
writeln(i);
end;
readln;
end.
As was mentioned by the user 500 - Internal Server Error and Marat Talipov
you want:
i:=random(xHigher-xLower)+xLower;
You should also use the Randomize; call before you call Random so that you get a new random value each time. So in the end:
var x, xRange, i,count,xLower, xhigher:integer;
begin
Randomize;
x:=7;
xLower:=x-2;
xHigher:=x+2;
for count:= 1 to 20 do
begin
i:=random(xHigher-xLower)+xLower;
writeln(i);
end;
readln;
end.
Related
sorting system and the main problem starts from the "Until" function. I would like to hear someones opinion about what I did wrong, and if there is an easier solution, I will appreciate if u told me about it.
The idea of the problem is: you have n number of people, and u need do introduce each one from the keyboard. Then, I need to sort them alphabeticlly
uses crt;
type Data = record
day : 1..31;
month : 1..12;
year : integer;
end;
Persoana = record
Name : string;
BirthDate : Data;
end;
ListaPersoane = array [1..50] of Persoana;
var x : ListaPersoane;
n:1..50;
i,z,j,l,a,v:integer;
y, k : longint;
aux : string;
begin
writeln('Program created on: 13/10/2020;');
writeln('give the number of people (max. 50):');
readln(n);
for i:=1 to n do begin
ClrScr;
writeln('Insert the name of person ', i, ': '); readln(x[i].Name);
writeln('Insert the date o birth:'); writeln('day:'); readln(x[i].BirthDate.day);
writeln('month:'); readln(x[i].BirthDate.month);
writeln('year:'); readln(x[i].BirthDate.year);
ClrScr;
end;
writeln('_______________________');
for i:=1 to n do begin
writeln(i, ') ', x[i].Name, ' ', x[i].BirthDate.day, '/', x[i].BirthDate.month, '/', x[i].BirthDate.year, ';');
writeln('_______________________');
end;
writeln();
repeat
k:=0;
for i:=1 to n do begin
j:=1;
repeat
Inc(j);
until (x[i].Name[j]>x[i].Name[j]) or (x[i].Name[j]<x[i].Name[j]);
if(x[i].Name[j]>x[i+1].Name[j]) then begin
aux:=x[i].Name;
x[i].Name:=x[i+1].Name;
x[i+1].Name:=aux;
z:=x[i].BirthDate.day;
x[i].BirthDate.day:=x[i+1].BirthDate.day;
x[i+1].BirthDate.day:=z;
l:=x[i].BirthDate.month;
x[i].BirthDate.month:=x[i+1].BirthDate.month;
x[i+1].BirthDate.month:=l;
a:=x[i].BirthDate.year;
x[i].BirthDate.year:=x[i+1].BirthDate.year;
x[i+1].BirthDate.year:=a;
Inc(k);
end;
end;
until (k=0);
writeln('_______________________');
for i:=1 to n do begin
writeln(i, ') ', x[i].Name, ' ', x[i].BirthDate.day, '/', x[i].BirthDate.month, '/', x[i].BirthDate.year, ';');
writeln('_______________________');
end;
writeln();
end.
I would expect that PascalABC can compare two strings and return which one is "smaller" or "bigger", without looping through the characters.
But to draw your attention to (at least) three issues in your sorting code, consider this code of yours:
j := 1;
repeat
Inc(j);
until (x[i].Name[j] > x[i].Name[j]) or (x[i].Name[j] < x[i].Name[j]);
Issue 1:
You initialize j := 1 before the loop. Then before you use j to index a character, you increment it. Thus you never attempt to compare the first character.
Issue 2:
Your repeat loop doesn't take into consideration that names have a limited, and often different length.
Issue 3:
Will either of these conditions, on the until row, ever be true:
(x[i].Name[j] > x[i].Name[j])
or this:
(x[i].Name[j] < x[i].Name[j])
In the subsequent code you correctly compare a character in x[i] with x[i+1]
I leave the correction of these errors for you, yourself, to correct. Consult with your tutor if needed.
You have a repeat .. until which terminates when k=0. You start with k assigned 0, then never change k. Perhaps your repeat is terminating because you don’t change k in the loop.
I started learning Pascal :) and I was interested on making a kind of Euromillion... However, I don't know how to forbid the same numbers or stars...
I thought this (below) would solve it... But it didn't... Help?
Program euromillion;
var num: array [1..5] of integer;
Procedure numbers;
var i, j: integer;
Begin
write ('Digite o número 1: ');
readln (num[1]);
for i:=2 to 5 do
for j:=1 to (i-1) do
Begin
repeat
write ('Digite o número ', i, ': ');
readln (num[i]);
until (num[i]>=1) and (num[i]<=50) and ((num[i]=num[j])=false);
End;
End;
Begin
numbers;
readln();
End.
Thanks guys :)
Although it is tempting to try and write a single block of code, as you have, it is better not to. Instead, a better way to write a program like this
is to think about splitting the task up into a number of procedures or functions
each of which only does a single part of the task.
One way to look at your task is to split it up into sub-tasks, as follows:
You prompt the user to enter a series of numbers
Once each number is entered, you check whether it is already in the array
If it isn't, you enter it in the array, otherwise prompt the user for another number
Once the array is filled, you output the numbers in the array
So, a key thing is that it would be helpful to have a function that checks whether
a new number is already in the array and returns True if it is and False otherwise. How to do that is the answer to your question.
You need to be careful about this because if you use the array a second time in the
program, you need to avoid comparing the new number with the array contents from
the previous time. I deliberately have not solved that problem in the example code below, to leave it as an exercise for the reader. Hint: One way would be to write a procedure which "clears" the array before each use of it, e.g. by filling it with numbers which are not valid lottery numbers, like negative numbers or zero. Another way would be to define a record which includes the NumberArray and a Count field which records how many numbers have been entered so far: this would avoid comparing the new number to all the elements in the
array and allow you to re-use the array by resetting the Count field to zero before calling ReadNumbers.
program LotteryNumbers;
uses crt;
type
TNumberArray = array[1..5] of Integer;
var
Numbers : TNumberArray;
Number : Integer;
function IsInArray(Number : Integer; Numbers : TNumberArray) : Boolean;
var
i : Integer;
begin
Result := False;
for i:= Low(Numbers) to High(Numbers) do begin
if Numbers[i] = Number then begin
Result := True;
break;
end;
end
end;
procedure ReadNumbers(var Numbers : TNumberArray);
var
i : Integer;
NewNumber : Integer;
OK : Boolean;
begin
// Note: This function needs to have a check added to it that the number
// the user enters is a valid lottery number, in other words that the
// number is between 1 and the highest ball number in the lottery
for i := Low(Numbers) to High(Numbers) do begin
repeat
OK := False;
writeln('enter a number');
ReadLn(NewNumber);
OK := not IsInArray(NewNumber, Numbers);
if not OK then
writeln('Sorry, you''ve already chosen ', NewNumber);
until OK;
Numbers[i] := NewNumber;
end;
end;
procedure ListNumbers(Numbers : TNumberArray);
var
i : Integer;
begin
for i := Low(Numbers) to High(Numbers) do
writeln(Numbers[i]);
end;
begin
ReadNumbers(Numbers);
ListNumbers(Numbers);
writeln('press any key');
readkey;
end.
I was trying to use same printing procedure for two types of arrays(1st arry length was 10, 2nd array length was 15).
I could not find any solution over internet. Did any one have any solution for this problem.
this is the Two arrays
program pp1;
const
m=10;
n=15;
type
matrix1=array[1..m] of integer;
matrix2=array[1..n] of integer;
var
m1:matrix1;
m2:matrix2;
this is the method which it tried. in method 'x' mens the length of the array.
procedure writeMatrix(var data: array of integer ;x:integer);
var
j:integer;
begin
for j:=1 to x do
begin
write(data[j]:3);
end;
end;
my main method
begin
writeMatrix(m1,10);
writeMatrix(m2,10);
end.
How can i use the same this writeMatrix method to print both of the arrays.. Is there any stranded way to do it.
As I said in my comment before, your implementation is fine, but you have to put something in your matrix before printing it, or you will get a bunch of zeroes in the screen (in the best).
Try this:
program pp1;
const
m=10;
n=15;
type
matrix1=array[1..m] of integer;
matrix2=array[1..n] of integer;
var
m1:matrix1;
m2:matrix2;
procedure fillMatrix(var data:array of integer; x:integer);
var
j:integer;
begin
for j:= 1 to x do begin
data[j]:=j;
end;
end;
procedure writeMatrix(var data: array of integer; x:integer);
var
j:integer;
begin
for j:=1 to x do
begin
write(data[j]:3);
end;
end;
begin
fillMatrix(m1,10);
fillMatrix(m2,10);
writeMatrix(m1,10);
writeMatrix(m2,10);
readln;
readln;
end.
Hint: consider avoid using global variables, m1 and m2 in this case should be declared in the main program.
How can i use the same this writeMatrix method to print both of the arrays.. Is there any stranded way to do it.
Yes, there is a standard way to this. It is called conformant-array parameters. It is standardized in (level 1) of the ISO standard 7185 (Standard “Unextended” Pascal). It looks like this:
procedure print(protected matrix: array[
columnMinimum..columnMaximum: integer;
rowMinimum..rowMaximum: integer
] of integer);
const
totalWidth = 6;
var
x: type of columnMinimum;
y: type of rowMinimum;
begin
for y := rowMinimum to rowMaximum do
begin
for x := columnMinimum to columnMaximum do
begin
write(matrix[x, y]:totalWidth);
end;
writeLn;
end;
end;
It’s as if there were additional const values, but they are dynamic depending on the passed matrix. This code furthermore uses type inquiries (type of …) and the protected modifier, both defined in ISO 10206 (Extended Pascal) which builds on top of ISO 7185. In EP you could and would also consider schemata to pass such data as parameters.
i have to do the following thing.
Make a program in Pascal that after has read a text with a list of nums., it will return the numb. of the nums that appear less than one times in the text.
The text that will be read from the program should be like that.
In the first line there are two nums. seperated by a space, n and m. N is the number of nums that exist, like if the text contains the numbers 1,2,3,4, n is 4 (1..n). M is how many lines follow. Every line has a couple of nums, a,b, (1=b) a and b are separated by a space.
The file that the program will make will have written on it a num., that says how many nyms are appeared less than two tims in the text.
All the nums. are Integer.
0=
I have finished it, but the problem is that at the new text that p has to be written, p is always 1, For me the problem is at the place that i have the bold letters, it might be because i in count and i in a arrays are different, how can i correct this???
Thank you in advance.
program MyProgr;
var
F: text;
t:Textfile;
a,count:array of Integer;
b:Integer;
i,int:Integer;
countnums:Integer;
n,m:String;
lin,nums:Integer;
Small,Big:Integer;
procedure DoWhatEver(S: string);
begin
val(s,int);
Write(s,' ');
for i:=Small to Big do
if (a[i]=int) then
count[i]:=count[i]+1;
end;
procedure FilltheArray;
begin
for i:=Small to Big do
a[i]:=i+1 ;
end;
procedure ProcessString;
var
Strng, S: string;
Last, P: integer;
begin
readln(F,Strng);
Last:=0;
while Last<length(Strng) do
begin
P:=Last+1;
while (P<=length(Strng)) and (Strng[P]<>' ') do
inc(P);
S:=copy(Strng,Last+1,(P-Last-1));
DoWhatEver(S);
Last:=P;
end
end;
procedure ProcessStringA;
var
Strng: string;
Last, P: integer;
begin
readln(F,Strng);
Last:=0;
while Last<length(Strng) do
begin
P:=Last+1;
while (P<=length(Strng)) and (Strng[P]<>' ') do
inc(P);
n:=copy(Strng,Last+1,(P-Last-1));
Val(n,nums);
Last:=P;
end
end;
procedure ProcessStringB;
var
Strng: string;
Last, P: integer;
begin
readln(F,Strng);
Last:=0;
while Last<length(Strng) do
begin
P:=Last+1;
while (P<=length(Strng)) and (Strng[P]<>' ') do
inc(P);
m:=copy(Strng,Last+1,(P-Last-1));
Val(m,lin);
Last:=P;
end
end;
begin
assign(F,'myfile.txt');
reset(F);
ProcessStringA;
Writeln(nums);
ProcessStringB;
Writeln(lin);
setlength(a,nums);
Small:=Low(a);
Big:=High(a);
for i:= Small to big do
count[i]:=0;
FillTheArray;
while not eof(F) do
ProcessString;
for i:=Small to Big do
begin
if count[i]=2 then
countnums:=countnums+1;
end;
Close(f);
Assign(t,'fileout.txt');
Rewrite(t);
Writeln(t,countnums);
close(t);
end.
I was trying to speed up a certain routine in an application, and my profiler, AQTime, identified one method in particular as a bottleneck. The method has been with us for years, and is part of a "misc"-unit:
function cwLeftPad(aString:string; aCharCount:integer; aChar:char): string;
var
i,vLength:integer;
begin
Result := aString;
vLength := Length(aString);
for I := (vLength + 1) to aCharCount do
Result := aChar + Result;
end;
In the part of the program that I'm optimizing at the moment the method was called ~35k times, and it took a stunning 56% of the execution time!
It's easy to see that it's a horrible way to left-pad a string, so I replaced it with
function cwLeftPad(const aString:string; aCharCount:integer; aChar:char): string;
begin
Result := StringOfChar(aChar, aCharCount-length(aString))+aString;
end;
which gave a significant boost. Total running time went from 10,2 sec to 5,4 sec. Awesome! But, cwLeftPad still accounts for about 13% of the total running time. Is there an easy way to optimize this method further?
Your new function involves three strings, the input, the result from StringOfChar, and the function result. One of them gets destroyed when your function returns. You could do it in two, with nothing getting destroyed or re-allocated.
Allocate a string of the total required length.
Fill the first portion of it with your padding character.
Fill the rest of it with the input string.
Here's an example:
function cwLeftPad(const aString: AnsiString; aCharCount: Integer; aChar: AnsiChar): AnsiString;
var
PadCount: Integer;
begin
PadCount := ACharCount - Length(AString);
if PadCount > 0 then begin
SetLength(Result, ACharCount);
FillChar(Result[1], PadCount, AChar);
Move(AString[1], Result[PadCount + 1], Length(AString));
end else
Result := AString;
end;
I don't know whether Delphi 2009 and later provide a double-byte Char-based equivalent of FillChar, and if they do, I don't know what it's called, so I have changed the signature of the function to explicitly use AnsiString. If you need WideString or UnicodeString, you'll have to find the FillChar replacement that handles two-byte characters. (FillChar has a confusing name as of Delphi 2009 since it doesn't handle full-sized Char values.)
Another thing to consider is whether you really need to call that function so often in the first place. The fastest code is the code that never runs.
Another thought - if this is Delphi 2009 or 2010, disable "String format checking" in Project, Options, Delphi Compiler, Compiling, Code Generation.
StringOfChar is very fast and I doubt you can improve this code a lot. Still, try this one, maybe it's faster:
function cwLeftPad(aString:string; aCharCount:integer; aChar:char): string;
var
i,vLength:integer;
origSize: integer;
begin
Result := aString;
origSize := Length(Result);
if aCharCount <= origSize then
Exit;
SetLength(Result, aCharCount);
Move(Result[1], Result[aCharCount-origSize+1], origSize * SizeOf(char));
for i := 1 to aCharCount - origSize do
Result[i] := aChar;
end;
EDIT: I did some testing and my function is slower than your improved cwLeftPad. But I found something else - there's no way your CPU needs 5 seconds to execute 35k cwLeftPad functions except if you're running on PC XT or formatting gigabyte strings.
I tested with this simple code
for i := 1 to 35000 do begin
a := 'abcd1234';
b := cwLeftPad(a, 73, '.');
end;
and I got 255 milliseconds for your original cwLeftPad, 8 milliseconds for your improved cwLeftPad and 16 milliseconds for my version.
You call StringOfChar every time now. Of course this method checks if it has something to do and jumps out if length is small enough, but maybe the call to StringOfChar is time consuming, because internally it does another call before jumping out.
So my first idea would be to jump out by myself if there is nothing to do:
function cwLeftPad(const aString: string; aCharCount: Integer; aChar: Char;): string;
var
l_restLength: Integer;
begin
Result := aString;
l_restLength := aCharCount - Length(aString);
if (l_restLength < 1) then
exit;
Result := StringOfChar(aChar, l_restLength) + aString;
end;
You can speed up this routine even more by using lookup array.
Of course it depends on your requirements. If you don't mind wasting some memory...
I guess that the function is called 35 k times but it has not 35000 different padding lengths and many different chars.
So if you know (or you are able to estimate in some quick way) the range of paddings and the padding chars you could build an two-dimensional array which include those parameters.
For the sake of simplicity I assume that you have 10 different padding lengths and you are padding with one character - '.', so in example it will be one-dimensional array.
You implement it like this:
type
TPaddingArray = array of String;
var
PaddingArray: TPaddingArray;
TestString: String;
function cwLeftPad4(const aString:string; const aCharCount:integer; const aChar:char; var anArray: TPaddingArray ): string;
begin
Result := anArray[aCharCount-length(aString)] + aString;
end;
begin
//fill up the array
SetLength(StrArray, 10);
PaddingArray[0] := '';
PaddingArray[1] := '.';
PaddingArray[2] := '..';
PaddingArray[3] := '...';
PaddingArray[4] := '....';
PaddingArray[5] := '.....';
PaddingArray[6] := '......';
PaddingArray[7] := '.......';
PaddingArray[8] := '........';
PaddingArray[9] := '.........';
//and you call it..
TestString := cwLeftPad4('Some string', 20, '.', PaddingArray);
end;
Here are benchmark results:
Time1 - oryginal cwLeftPad : 27,0043604142394 ms.
Time2 - your modyfication cwLeftPad : 9,25971967336897 ms.
Time3 - Rob Kennedy's version : 7,64538131122457 ms.
Time4 - cwLeftPad4 : 6,6417059620664 ms.
Updated benchmarks:
Time1 - oryginal cwLeftPad : 26,8360194218451 ms.
Time2 - your modyfication cwLeftPad : 9,69653117046119 ms.
Time3 - Rob Kennedy's version : 7,71149259179622 ms.
Time4 - cwLeftPad4 : 6,58248533610693 ms.
Time5 - JosephStyons's version : 8,76641780969192 ms.
The question is: is it worth the hassle?;-)
It's possible that it may be quicker to use StringOfChar to allocate an entirely new string the length of string and padding and then use move to copy the existing text over the back of it.
My thinking is that you create two new strings above (one with FillChar and one with the plus). This requires two memory allocates and constructions of the string pseudo-object. This will be slow. It may be quicker to waste a few CPU cycles doing some redundant filling to avoid the extra memory operations.
It may be even quicker if you allocated the memory space then did a FillChar and a Move, but the extra fn call may slow that down.
These things are often trial-and-error!
You can get dramatically better performance if you pre-allocate the string.
function cwLeftPadMine
{$IFDEF VER210} //delphi 2010
(aString: ansistring; aCharCount: integer; aChar: ansichar): ansistring;
{$ELSE}
(aString: string; aCharCount: integer; aChar: char): string;
{$ENDIF}
var
i,n,padCount: integer;
begin
padCount := aCharCount - Length(aString);
if padCount > 0 then begin
//go ahead and set Result to what it's final length will be
SetLength(Result,aCharCount);
//pre-fill with our pad character
FillChar(Result[1],aCharCount,aChar);
//begin after the padding should stop, and restore the original to the end
n := 1;
for i := padCount+1 to aCharCount do begin
Result[i] := aString[n];
end;
end
else begin
Result := aString;
end;
end;
And here is a template that is useful for doing comparisons:
procedure TForm1.btnPadTestClick(Sender: TObject);
const
c_EvalCount = 5000; //how many times will we run the test?
c_PadHowMany = 1000; //how many characters will we pad
c_PadChar = 'x'; //what is our pad character?
var
startTime, endTime, freq: Int64;
i: integer;
secondsTaken: double;
padIt: string;
begin
//store the input locally
padIt := edtPadInput.Text;
//display the results on the screen for reference
//(but we aren't testing performance, yet)
edtPadOutput.Text := cwLeftPad(padIt,c_PadHowMany,c_PadChar);
//get the frequency interval of the OS timer
QueryPerformanceFrequency(freq);
//get the time before our test begins
QueryPerformanceCounter(startTime);
//repeat the test as many times as we like
for i := 0 to c_EvalCount - 1 do begin
cwLeftPad(padIt,c_PadHowMany,c_PadChar);
end;
//get the time after the tests are done
QueryPerformanceCounter(endTime);
//translate internal time to # of seconds and display evals / second
secondsTaken := (endTime - startTime) / freq;
if secondsTaken > 0 then begin
ShowMessage('Eval/sec = ' + FormatFloat('#,###,###,###,##0',
(c_EvalCount/secondsTaken)));
end
else begin
ShowMessage('No time has passed');
end;
end;
Using that benchmark template, I get the following results:
The original: 5,000 / second
Your first revision: 2.4 million / second
My version: 3.9 million / second
Rob Kennedy's version: 3.9 million / second
This is my solution. I use StringOfChar instead of FillChar because it can handle unicode strings/characters:
function PadLeft(const Str: string; Ch: Char; Count: Integer): string;
begin
if Length(Str) < Count then
begin
Result := StringOfChar(Ch, Count);
Move(Str[1], Result[Count - Length(Str) + 1], Length(Str) * SizeOf(Char));
end
else Result := Str;
end;
function PadRight(const Str: string; Ch: Char; Count: Integer): string;
begin
if Length(Str) < Count then
begin
Result := StringOfChar(Ch, Count);
Move(Str[1], Result[1], Length(Str) * SizeOf(Char));
end
else Result := Str;
end;
It's a bit faster if you store the length of the original string in a variable:
function PadLeft(const Str: string; Ch: Char; Count: Integer): string;
var
Len: Integer;
begin
Len := Length(Str);
if Len < Count then
begin
Result := StringOfChar(Ch, Count);
Move(Str[1], Result[Count - Len + 1], Len * SizeOf(Char));
end
else Result := Str;
end;
function PadRight(const Str: string; Ch: Char; Count: Integer): string;
var
Len: Integer;
begin
Len := Length(Str);
if Len < Count then
begin
Result := StringOfChar(Ch, Count);
Move(Str[1], Result[1], Len * SizeOf(Char));
end
else Result := Str;
end;