Free Pascal: detect "is word char" for WideChar - lazarus

I use code
Result:=
((ch>='0') and (ch<='9')) or
((ch>='a') and (ch<='z')) or
((ch>='A') and (ch<='Z')) or
(ch='_');
it detects ok AnsiChar; how to detect "if char letter or digit" for WideChar?

I guess there's no simple way to solve this. What's your definition of a letter? Ω (omega) is a letter? is it just a symbol? You would have to manually decide what is a letter and what is not. You could make a big case statement that determines whether a char is alpha numeric or not...
function is_alpha_num(ch : widechar) : boolean;
begin
case ch of
#$0030..#$0039, // '0'..'9'
#$0041..#$005A, // 'A'..'Z'
#$0061..#$007A, // 'a'..'z'
// need to define the rest here...
#$FF21..#$FF3A // 'A'..'Z'
: result := true;
else result := false;
end;
end;

Related

How to remove spaces from string with while do operator? Pascal

I have text and I need to remove spaces from beginning of text and from end of text. And I can do it only with while do operator. How can I do that? Here's program code
program RandomTeksts;
uses crt;
var
t:String;
l, x, y:Integer;
const tmin=1; tmax=30;
label
Start,
end;
begin
Start:
clrscr;
writeln('write text (from ',tmin,' to ',tmax,' chars): ');
readln(t);
l:=length(t);
if (l<tmin) or (l>tmax) then
begin
writeln('Text doesn't apply to rules!');
goto end;
end;
clrscr;
begin
randomize;
repeat
x:=random(52+1);
y:=random(80+1);
textcolor(white);
gotoxy(x,y);
writeln(t);
delay(700);
clrscr;
until keypressed;
end;
ord (readkey)<>27 then
goto Start;
end:
end.
Academic problem: Remove leading and trailing spaces from a string using a while loop.
How do we approach this problem?
Well, we certainly would like to create a function that trims a string. This way, we can simply call this function every time we need to perform such an operation. This will make the code much more readable and easier to maintain.
Clearly, this function accepts a string and returns a string. Hence its declaration should be
function Trim(const AText: string): string;
Here I follow the convention of prefixing arguments by "A". I also use the const prefix to tell the compiler I will not need to modify the argument within the function; this can improve performance (albeit very slightly).
The definition will look like this:
function Trim(const AText: string): string;
begin
// Compute the trimmed string and save it in the result variable.
end;
A first attempt
Now, let's attempt to implement this algorithm using a while loop. Our first attempt will be very slow, but fairly easy to follow.
First, let us copy the argument string AText to the result variable; when the function returns, the value of result will be its returned value:
result := AText;
Now, let us try to remove leading space characters.
while result[1] = ' ' do
Delete(result, 1, 1);
We test if the first character, result[1], is a space character and if it is, we use the Delete procedure to remove it from the string (specifically, Delete(result, 1, 1) removes 1 character from the string starting at the character with index 1). Then we do this again and again, until the first character is something other than a space.
For example, if result initially is ' Hello, World!', this will make it equal to 'Hello, World!'.
Full code, so far:
function Trim(const AText: string): string;
begin
result := AText;
while result[1] = ' ' do
Delete(result, 1, 1);
end;
Now try this with a string that consists only of space characters, such as ' ', or the empty string, ''. What happens? Why?
Think about it.
Clearly, in such a case, result will sooner or later be the empty string, and then the character result[1] doesn't exist. (Indeed, if the first character of result would exist, result would be of length at least 1, and so it wouldn't be the empty string, which consists of precisely zero characters.)
Accessing a character that doesn't exist will make the program crash.
To fix this bug, we change the loop to this:
while (Length(result) >= 1) and (result[1] = ' ') do
Delete(result, 1, 1);
Due to a technique known as 'lazy boolean evaluation' (or 'short-circuit evaluation'), the second operand of the and operator, that is, result[1] = ' ', will not even run if the first operand, in this case Length(result) >= 1, evaluates to false. Indeed, false and <anything> equals false, so we already know the value of the conjunction in this case.
In other words, result[1] = ' ' will only be evaluated if Length(result) >= 1, in which case there will be no bug. In addition, the algorithm produces the right answer, because if we eventually find that Length(result) = 0, clearly we are done and should return the empty string.
Removing trailing spaces in a similar fashion, we end up with
function Trim(const AText: string): string;
begin
result := AText;
while (Length(result) >= 1) and (result[1] = ' ') do
Delete(result, 1, 1);
while (Length(result) >= 1) and (result[Length(result)] = ' ') do
Delete(result, Length(result), 1);
end;
A tiny improvement
I don't quite like the space character literals ' ', because it is somewhat difficult to tell visually how many spaces there are. Indeed, we might even have a different whitespace character than a simple space. Hence, I would write #32 or #$20 instead. 32 (decimal), or $20 (hexadecimal), is the character code of a normal whitespace.
A (much) better solution
If you try to trim a string containing many million of characters (including a few million leading and trailing spaces) using the above algorithm, you'll notice that it is surprisingly slow. This is because we in every iteration need to reallocate memory for the string.
A much better algorithm would simply determine the number of leading and trailing spaces by reading characters in the string, and then in a single step perform a memory allocation for the new string.
In the following code, I determine the index FirstPos of the first non-space character in the string and the index LastPos of the last non-space character in the string:
function Trim2(const AText: string): string;
var
FirstPos, LastPos: integer;
begin
FirstPos := 1;
while (FirstPos <= Length(AText)) and (AText[FirstPos] = #32) do
Inc(FirstPos);
LastPos := Length(AText);
while (LastPos >= 1) and (AText[LastPos] = #32) do
Dec(LastPos);
result := Copy(AText, FirstPos, LastPos - FirstPos + 1);
end;
I'll leave it as an exercise for the reader to figure out the precise workings of the algorithm. As a bonus exercise, try to benchmark the two algorithms: how much faster is the last one? (Hint: we are talking about orders of magnitude!)
A simple benchmark
For the sake of completeness, I wrote the following very simple test:
const
N = 10000;
var
t: cardinal;
dur1, dur2: cardinal;
S: array[1..N] of string;
S1: array[1..N] of string;
S2: array[1..N] of string;
i: Integer;
begin
Randomize;
for i := 1 to N do
S[i] := StringOfChar(#32, Random(10000)) + StringOfChar('a', Random(10000)) + StringOfChar(#32, Random(10000));
t := GetTickCount;
for i := 1 to N do
S1[i] := Trim(S[i]);
dur1 := GetTickCount - t;
t := GetTickCount;
for i := 1 to N do
S2[i] := Trim2(S[i]);
dur2 := GetTickCount - t;
Writeln('trim1: ', dur1, ' ms');
Writeln('trim2: ', dur2, ' ms');
end.
I got the following output:
trim1: 159573 ms
trim2: 484 ms

How to forbid equal numbers

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.

Error : Operator is not overloaded

I've created a simple block of code using Free Pascal to validate an ID number such as Abc123 being input.
When I try to run the program I get an error saying, "Operator is not overloaded" at the points where it says,
IF not (Ucase in Upper) or (Lcase in Lower) or (Num in Int) then
Specifically where the "in" appears.
Does anyone have any idea why the error occurs and what I can do to solve it?
Thanks!
Program CheckChar;
VAR
UserID, LCase, UCase, Num : String;
readkey : char;
L : Integer;
CONST
Upper = ['A'..'Z'];
Lower = ['a'..'z'];
Int = ['0'..'9'];
Begin
Write('Enter UserID ');Readln(UserID);
Ucase := Copy(UserID,1,1);
LCase := Copy(UserID,2,1);
Num := Copy(UserID,3,2);
L := Length(UserID);
While L = 6 Do
Begin
IF not (Ucase in Upper) or (Lcase in Lower) or (Num in Int) then
Begin
Writeln('Invalid Input');
End;
Else
Writeln('Input is valid');
End;
readln(readkey);
End.
in is used to test the presence of an element in a set. Here you set is a set of char, so the element to test must also be a char. In your sample the elements you tested were some strings (UCase, LCase and Num) which caused the error message.
You have to use a slice of Ucase and LCase of length one or you can also directly take a single character (astring[index]) instead of copying with Copy.
Also your while loop is totally useless. You have to test only 6 characters so let's unroll the loop instead of puting some complexity while obsvioulsy you just start learning.
Finally, one way to write your checker correctly is so:
Program CheckChar;
var
UserID : string;
readkey : char;
L : Integer;
invalid: boolean;
const
Upper = ['A'..'Z'];
Lower = ['a'..'z'];
Int = ['0'..'9'];
begin
Write('Enter UserID ');
Readln(UserID);
L := length(UserId);
if L <> 6 then invalid := true
else
begin
invalid := not (UserID[1] in Upper) or // take a single char, usable with in
not (UserID[2] in Lower) or // ditto
not (UserID[3] in Lower) or // ditto
not (UserID[4] in Int) or // ditto
not (UserID[5] in Int) or // ditto
not (UserID[6] in Int); // ditto
end;
if invalid then
Writeln('Invalid Input')
else
Writeln('Input is valid');
readln(readkey);
end.

Pascal compiles and closes straight away despite readln;

program words;
uses crt;
type
T2DArray = array[1..100, 1..100] of string;
var
ch:char;
x,y:integer;
MapArray: T2DArray;
begin
x:=0;
y:=0;
repeat
MapArray[10, 10] := 'you are at a tree';
writeln(MapArray[x,y]);
write('current positon is ');
write(x);write(',');write(y);
ch:=ReadKey;
case ch of
#0 : begin
ch:=ReadKey; {Read ScanCode}
case ch of
'w' : y:=y+1;
'a' : x:=x-1;
's' : y:=y-1;
'd' : x:=x+1;
end;
end;
#27 : WriteLn('ESC');
end;
until ch=#27;
readln;
end.
i have this simple piece of code that will allow me to assign things to XY coordinates of a 2d array. the code compiles and closes straight away despite the readln; at the bottom.
All the best Arran.
Always enable range-checking {$R+} during development. You have a 1-based array but your x and y values are zero the first time you read from it.

Help in Pascal writing a word counter

I have to write a program in Pascal which has to detect how many words on a text (input by the user) start with a certain letter. I can't use arrays, can you give me any hints as to where to start?
If you know which letter, you merely need to keep a counter, no need for arrays.
If you don't know which letter, keep 26 counters. Stupid, but works as per your spec.
First thing to do is define the set of characters that constitute letters, or conversely which ones constitute non-letters.
Write a function that takes a character and returns a boolean based on whether that character is a letter. Then loop through the string and call it for each character. When you detect a letter right after a non-letter or at the start of the string, increment your counter if it is the target letter.
count instances of SPACE LETTER plus first word if it matches.
(S) is your input string;
Create a for loop that goes from 1 to the length of (S) - 1.
Inside loop, check is (S)[i] = ' ' and (S)[i+1] = 't' where i is the loop counter and 't' is the letter starting the word you want to count
If criteria in step two matches then increment a counter.
Note the minus one on the loop size.
Also, remember that the very first letter of the string may be the one you want to match and that will not get picked up by the loop defined above.
If you need to make your code smarter in that it can locate a specific letter rather than a hardcoded 't' then you can pass the requested character as a parameter to the function/procedure that your loop is in.
Off the top of my head - not tested
function WordCount(const S: string; const C: Char): Integer;
const
ValidChars: Set of Char [A..Z, a..z]; // Alter for appropriate language
var
i : Integer;
t : string;
begin
Result := 0;
if Length(S) <> 0 then
begin
t := Trim(S); // lose and leading and trailing spaces
t := t + ' '; // make sure a space is the last char
repeat
if (t[1] in ValidChars) and (t[1] = C then
inc(Result);
i := Pos(' ', t);
t := Copy(t(i+1, Length(t));
until Length(t) = 0;
end;
end;
Why would you need an array or a case statement?

Resources