Please note, this is a STATIC archive of website www.tutorialspoint.com from 11 May 2019, cach3.com does not collect or store any user information, there is no "phishing" involved.
program ArithmeticTest; // COPY INTO LAZARUS TO RUN
type
question = class
public
num1: integer;
num2: integer;
mode: string;
answer: real;
constructor create(n1, n2, m: integer);
end;
var
name: string;
questionNum, answer: integer;
questions: array [1..10] of question;
answers: array [1..10] of real;
constructor question.create(n1, n2, m: integer);
begin
num1 := n1;
num2 := n2;
if m = 1 then
begin
answer := num1 + num2;
mode := '+';
end
else if m = 2 then
begin
answer := num1 - num2;
mode := '-';
end
else if m = 3 then
begin
answer := num1 * num2;
mode := '*';
end
else if m = 4 then
begin
answer := num1 / num2;
mode := '/';
end;
end;
procedure generateQuestion(questionNum: integer);
begin
questions[questionNum] := question.create(random(20) + 1, random(20) + 1, random(4) + 1);
writeln('What is ', questions[questionNum].num1, ' ', questions[questionNum].mode, ' ', questions[questionNum].num2, '?');
end;
procedure checkAnswer (questionNum: integer);
var
inputAnswer, correctAnswer: real;
begin
inputAnswer := round(answers[questionNum] * 100) / 100;
correctAnswer := round(questions[questionNum].answer * 100) / 100;
if inputAnswer = correctAnswer then
writeln('Question ', questionNum, ': correct')
else
writeln('Question ', questionNum, ': incorrect - correct answer is ', correctAnswer:0:2);
end;
begin
writeln('What is your name?');
readln(name);
randomize;
for questionNum := 1 to 10 do
begin
generateQuestion(questionNum);
readln(answers[questionNum]);
end;
for questionNum := 1 to 10 do
begin
checkAnswer(questionNum);
end;
readln;
end.
program NumberNames; // COPY INTO LAZARUS TO RUN
uses sysutils;
var
number: string;
pos, digitCounter: integer;
digitNames: array [0..19] of string = ('', 'one', 'two', 'three', 'four', 'five', 'six', 'seven', 'eight', 'nine', 'ten', 'eleven', 'twelve', 'thirteen', 'fourteen', 'fifteen', 'sixteen', 'seventeen', 'eighteen', 'nineteen');
tens: array [0..9] of string = ('', '', 'twenty', 'thirty', 'forty', 'fifty', 'sixty', 'seventy', 'eighty', 'ninety');
thousands: array [0..2] of string = ('', ' thousand ', ' million ');
numberName: array [1..99] of string;
begin
writeln('Enter a number between 1 and 1 million');
readln(number);
while length(number) mod 3 <> 0 do
number := concat('0', number);
pos := length(number);
digitCounter := 1;
while pos > 0 do
begin
if digitCounter mod 3 = 1 then
numberName[pos] := digitNames[strtoint(number[pos])]
else if digitCounter mod 3 = 2 then
begin
if number[pos] = '1' then
numberName[pos + 1] := digitNames[strtoint(concat(number[pos], number[pos + 1]))]
else
begin
numberName[pos] := tens[strtoint(number[pos])];
if (numberName[pos] <> '') and (numberName[pos + 1] <> '') then
numberName[pos] := concat(numberName[pos], ' ');
end;
end
else
begin
numberName[pos] := digitNames[strtoint(number[pos])];
if numberName[pos] <> '' then
numberName[pos] := concat(numberName[pos], ' hundred ');
if (numberName[pos] <> '') or (numberName[pos + 1] <> '') or (numberName[pos + 2] <> '') then
numberName[pos + 2] := concat(numberName[pos + 2], thousands[(digitCounter div 3) - 1]);
end;
pos -= 1;
digitCounter += 1;
end;
for pos := 1 to length(number) do
write(numberName[pos]);
readln;
end.
program sudoku;
uses crt;
type BoardArray = array[0..8,0..8] of integer;
var BD, BD2 :BoardArray; cx, cy :integer;
procedure DisplayBoard(BD :BoardArray);
var i, j :integer;
begin
writeln('+-------+-------+-------+');
for i := 0 to 8 do
begin
write('|');
for j := 0 to 8 do
begin
if BD[i,j] <> 0 then write(BD[i,j] :2)
else write(' ');
if j mod 3 = 2 then write(' |');
end;
writeln;
if i mod 3 = 2 then writeln('+-------+-------+-------+')
end
end;
procedure Initialize(var BD :BoardArray);
var i, j, k, temp :integer;
begin
for i := 0 to 8 do
for j := 0 to 8 do
BD[i,j] := 0;
for k := 0 to 8 do
BD[0,k] := k + 1;
for k := 1 to 1000 do
begin
j := random(9);
temp := BD[0,1];
BD[0,1] := BD[0,j];
BD[0,j] := temp
end
end;
function ValidFill(BD :BoardArray; p, q, x :integer) :boolean;
var i, j :integer; flag :boolean;
begin
flag := TRUE;
for i := 0 to 8 do
flag := flag and (BD[i,q] <> x);
for j := 0 to 8 do
flag := flag and (BD[p,j] <> x);
for i := p div 3 * 3 to (p div 3 + 1) * 3 - 1 do
for j := q div 3 * 3 to (q div 3 + 1) * 3 - 1 do
flag := flag and (BD[i,j] <> x);
ValidFill := flag
end;
function CompareBoard(BD1, BD2 :BoardArray) :boolean;
var flag :boolean; i, j :integer;
begin
flag := TRUE;
for i := 0 to 8 do
for j := 0 to 8 do
flag := flag and (BD1[i,j] = BD2[i,j]);
CompareBoard := flag
end;
procedure BackwardFill(var BD :BoardArray; p, q, x :integer);
var temp, i, j :integer;
begin
if x < 10 then
begin
if ValidFill(BD,p,q,x) then
begin
BD[p,q] := x;
if (p < 8) or (q < 8) then BackwardFill(BD,p + (q + 1) div 9,(q + 1) mod 9,1);
end
else BackwardFill(BD,p,q,x + 1)
end
else
begin
i := p - (9 - q) div 9;
j := (q + 8) mod 9;
temp := BD[i,j];
BD[i,j] := 0;
BackwardFill(BD,i,j,temp + 1)
end
end;
procedure BackwardFillv2(BD2 :BoardArray; var BD3 :BoardArray; p, q, x :integer);
var temp :integer;
begin
if x < 10 then
begin
if ValidFill(BD3,p,q,x) then
begin
BD3[p,q] := x;
repeat
p := p - (9 - q) div 9;
q := (q + 8) mod 9
until (p < 0) or (BD3[p,q] = 0);
if p >= 0 then BackwardFillv2(BD2,BD3,p,q,1)
end
else BackwardFillv2(BD2,BD3,p,q,x + 1);
end
else
begin
repeat
p := p + (q + 1) div 9;
q := (q + 1) mod 9
until (p > 8) or (BD2[p,q] = 0);
if p <= 8 then
begin
temp := BD3[p,q];
BD3[p,q] := 0;
BackwardFillv2(BD2,BD3,p,q,temp + 1);
end
end;
end;
procedure GenerateBoard(var BD :BoardArray);
var BD2, BD3 :BoardArray; i, j, p, q, r, s, x, temp, count, empty, diff :integer;
begin
randomize;
repeat
clrscr;
writeln('Please choose the difficulty: ');
writeln('1. Easy');
writeln('2. Medium');
writeln('3. Difficult');
write('Enter your choice: '); readln(diff);
writeln;
case diff of
1: writeln('You have chosen Easy. Pree <Enter> to start the game.');
2: writeln('You have chosen Medium. Pree <Enter> to start the game.');
3: writeln('You have chosen Difficult. Pree <Enter> to start the game.')
end
until diff in [1..3];
readln;
clrscr;
diff := diff * 6 + random(7) + 27;
Initialize(BD);
BackwardFill(BD,1,0,1);
BD2 := BD;
count := 0;
empty := 0;
repeat
temp := random(81 - count) + 1;
count := count + 1;
r := -1;
s := 8;
repeat
repeat
r := r + (s + 1) div 9;
s := (s + 1) mod 9
until BD2[r,s] <> 0;
temp := temp - 1
until temp = 0;
temp := BD2[r,s];
BD2[r,s] := 0;
BD3 := BD2;
for i := 0 to 8 do
for j := 0 to 8 do
if BD2[i,j] = 0 then
begin
p := i;
q := j
end;
BackwardFillv2(BD2,BD3,p,q,1);
for i := 8 downto 0 do
for j := 8 downto 0 do
if BD2[i,j] = 0 then
begin
p := i;
q := j
end;
x := BD3[p,q];
BD3[p,q] := 0;
BackwardFillv2(BD2,BD3,p,q,x + 1);
if CompareBoard(BD2,BD3) then empty := empty + 1
else BD2[r,s] := temp;
until empty = diff;
BD := BD2;
end;
procedure GetMove(var BD :BoardArray; BD2 :BoardArray; var cx, cy :integer);
var key :char; fill :boolean; x, y :integer;
begin
fill := FALSE;
repeat
x := cx div 3 * 8 + 3 + cx mod 3 * 2;
y := cy div 3 * 4 + 2 + cy mod 3;
gotoxy(x,y);
key := readkey;
case key of
#00: case ReadKey of
#72: cy := (cy + 8) mod 9;
#75: cx := (cx + 8) mod 9;
#77: cx := (cx + 1) mod 9;
#80: cy := (cy + 1) mod 9;
#83: begin
if BD2[cy,cx] = 0 then
begin
BD[cy,cx] := 0;
write(' ');
fill := TRUE
end
end
end;
#08: begin
if BD2[cy,cx] = 0 then
begin
BD[cy,cx] := 0;
write(' ');
fill := TRUE
end
end;
#49..#57: if BD2[cy,cx] = 0 then
begin
BD[cy,cx] := ord(key) - 48;
write(BD[cy,cx]);
fill := TRUE
end
end;
until fill
end;
function CheckBoard(BD :BoardArray) :boolean;
var i, j :integer; count :array[1..9] of integer;
begin
exit (FALSE)
end;
begin
GenerateBoard(BD);
DisplayBoard(BD);
textcolor(11);
BD2 := BD;
cx := 0;
cy := 0;
repeat
GetMove(BD,BD2,cx,cy);
gotoxy(1,15);
until CheckBoard(BD);
gotoxy(1,15);
textcolor(7);
writeln('Congtratulation! You clear the board!');
readln
end.
program funk;
var n,a,b : integer;
procedure sum;
var t : integer;
begin
t := a+b;
b := a;
a := t;
end;
begin
n:= 4;
a:= 1;
b := 0;
while n>0 do
begin
sum;
n:=n-1
end;
writeln(b,' ');
end.
program fib;
var n,a,b : integer;
procedure sum;
var t : integer;
begin
t := a+b;
b := a;
a := t;
end;
begin
n := 5;
a := 1;
b := 1;
writeln(b ,' ');
while n>0 do
begin
sum;
n := n-1;
writeln(b ,' ')
end;
end.
program ArithmeticTest;
type
question = class
public
num1: integer;
num2: integer;
mode: string;
answer: real;
constructor create(n1, n2, m: integer);
end;
var
name: string;
questionNum, answer: integer;
questions: array [1..10] of question;
answers: array [1..10] of real;
constructor question.create(n1, n2, m: integer);
begin
num1 := n1;
num2 := n2;
if m = 1 then
begin
answer := num1 + num2;
mode := '+';
end
else if m = 2 then
begin
answer := num1 - num2;
mode := '-';
end
else if m = 3 then
begin
answer := num1 * num2;
mode := '*';
end
else if m = 4 then
begin
answer := num1 / num2;
mode := '/';
end;
end;
procedure generateQuestion(questionNum: integer);
begin
questions[questionNum] := question.create(random(20) + 1, random(20) + 1, random(4) + 1);
writeln('What is ', questions[questionNum].num1, ' ', questions[questionNum].mode, ' ', questions[questionNum].num2, '?');
end;
procedure checkAnswer (questionNum: integer);
var
inputAnswer, correctAnswer: real;
begin
inputAnswer := round(answers[questionNum] * 100) / 100;
correctAnswer := round(questions[questionNum].answer * 100) / 100;
if inputAnswer = correctAnswer then
writeln('Question ', questionNum, ': correct')
else
writeln('Question ', questionNum, ': incorrect - correct answer is ', correctAnswer:0:2);
end;
begin
writeln('What is your name?');
readln(name);
randomize;
for questionNum := 1 to 10 do
begin
generateQuestion(questionNum);
readln(answers[questionNum]);
end;
for questionNum := 1 to 10 do
begin
checkAnswer(questionNum);
end;
readln;
end.
program recursiveFibonacci;
var
i: integer;
function fibonacci(n: integer): integer;
begin
if n=1 then
fibonacci := 0
else if n=2 then
fibonacci := 1
else
fibonacci := fibonacci(n-1) + fibonacci(n-2);
end;
begin
for i:= 1 to 30 do
write(fibonacci (i), ' ');
end.
{$mode objfpc}
Program fclstlset;
uses gvector, gset, gutil, dos;
type iLess = specialize TLess<longint>;
iVector = specialize TVector<longint>;
iSet = specialize TSet<longint,iLess>;
var V : iVector;
S : iSet;
N, i : longint;
it : iSet.TIterator;
hour,min,sec,msec,usec : word;
begin
read(N);
V := iVector.Create();
for i:=1 to N do V.PushBack(random(N));
GetTime(hour,min,sec,msec);
Writeln ('Time : ',hour,':',min,':',sec,':',msec);
S := iSet.Create();
for i:=0 to N-1 do S.Insert(V[i]);
V.Clear();
it := S.Min();
GetTime(hour,min,sec,msec);
Writeln ('Time : ',hour,':',min,':',sec,':',msec);
repeat V.PushBack( it.GetData() ); until not it.Next();
WriteLn('OK - ', V.Size())
end.
