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 Maximum (input, output);
{ Gibt das Maximum einer Benutzer-Zahlenfolge aus }
var
Eingabe,
MaxZahl : integer;
begin
writeln('Geben Sie beliebig viele integer-Zahlen ein. Eingabe wird mit 0 beendet.');
readln(Eingabe);
if Eingabe = 0 then
writeln('Leere Eingabefolge!')
else
begin
MaxZahl := Eingabe;
while Eingabe <> 0 do
{ Lese die Eingabe, bis eine 0 eingegeben wird }
begin
if Eingabe > MaxZahl then
{ Die groessere Zahl wird in MaxZahl abgelegt }
MaxZahl := Eingabe;
readln(Eingabe)
end;
writeln('Die groesste Zahl war die ', MaxZahl, '.')
end { else }
end. { Maximum }
program FindeNaechstePrimzahl (input, output);
{ bestimmt die zur Eingabezahl naechstgelegene(n)
Primzahl(en) }
type
tNatZahlPlus = 1..maxint;
var
EinZahl,
d : tNatZahlPlus; { d ist die Schrittweite,
"displacement" }
gefunden : boolean;
function istPrimzahl (p : tNatZahlPlus) : boolean;
{ liefert true, falls p Primzahl,sonst false}
var
q : tNatZahlPlus;
begin
if p < 2 then
istPrimzahl := false
else { p >= 2 }
begin
istPrimzahl := false;
q := 2;
while p mod q <> 0 do
begin
istPrimzahl := true;
q := q + 1
end
end
end; { istPrimzahl }
begin
writeln ('Zahl eingeben: ');
readln (EinZahl);
{ Um das Programm zu vereinfachen, verzichten wir
auf eine Ueberpruefung der Eingabe }
write ('Naechste Primzahl zu ', EinZahl, ' ist ');
if istPrimzahl (EinZahl) then
writeln (EinZahl)
else
if EinZahl = 1 then
writeln ('2':5)
else {EinZahl <> 1 }
begin
gefunden := false;
if odd (EinZahl) then
d := 2
else
d := 1;
repeat
if istPrimzahl (EinZahl + d) then
begin
{ Primzahl oberhalb von EinZahl gefunden }
gefunden := true;
write (EinZahl + d : 5)
end;
if istPrimzahl (EinZahl - d) then
begin
{ Primzahl unterhalb von EinZahl gefunden }
gefunden := true;
write (EinZahl - d : 5)
end;
d := d + 2
until gefunden;
writeln
end {EinZahl <> 1 }
end. { FindeNaechstePrimzahl }
Program SBA;
Uses sysutils;
type
AT = array[1..30] of AnsiString;
BT = array[1..10000] of string;
var
listline : AT;
listword : BT;
totalline , totalword , inp : integer;
target1 : string;
target2 : char;
procedure readfile (var listline : AT ; var totalline : integer);{read file}
var
f : text;
begin
assign(f , 'data.txt');
reset(f);
totalline := 0;
while not eof(f) do
begin
totalline := totalline + 1;
readln(f , listline[totalline]);
end;
close(f);
end;
procedure add (var listline : AT ; totalline : integer);{add a full stop at the end of composition to prevent user careless mistake}
begin
listline[totalline] := listline[totalline] + '.'
end;
procedure split (listline : AT ; totalline : integer ; var listword : BT ; var totalword : integer);{split sentence into word}
var
i , n , long : integer;
word : string;
temp : ansiString;
begin
totalword := 0;
for i := 1 to totalline do
begin
temp := listline[i];
word := '';
long := length(temp);
n := 1;
repeat
if ((temp[n] = ' ') or (temp[n] = '.') or (temp[n] = '?') or (temp[n] = '!') or (temp[n] = ',') or (temp[n] = ':') or (temp[n] = ';') or (temp[n] = '''') or (temp[n] = '"')) and (word <> '') and ((word <> ' ') or (word <> '.') or (word <> '!') or (word <> '?') or (word <> ',') or (word <> ':') or (word <> ';') or (word <> '''') or (word <> '"'))
then begin
totalword := totalword + 1;
listword[totalword] := word;
word := '';
end
else if (temp[n] = ' ') or (temp[n] = '.') or (temp[n] = '?') or (temp[n] = '!') or (temp[n] = ',') or (temp[n] = ':') or (temp[n] = ';') or (temp[n] = '''') or (temp[n] = '"')
then word := ''
else word := word + temp[n];
n := n + 1;
until n = long + 1;
end;
end;
function freword (listword : BT ; totalword : integer ; target : string) : integer; {find out frequency of given word}
var
word : string;
i , n , long , temp , count : integer;
begin
count := 0;
for i := 1 to totalword do
begin
temp := 0;
word := lowercase(listword[i]);
long := length(word);
for n := 1 to long do
if target[n] = word[n]
then temp := temp + 1;
if temp = long
then count := count + 1;
end;
freword := count;
end;
function freletter (listword : BT ; totalword : integer ; target : char) : integer;
var
word : string;
count , i , n , long : integer;
begin
count := 0;
for i := 1 to totalword do
begin
word := lowercase(listword[i]);
long := length(word);
for n := 1 to long do
if word[n] = target
then count := count + 1;
end;
freletter := count;
end;
begin{main program}
writeln('*Please rename your file into "data.txt" and put it into same layer of the program*');
writeln('*Please do not leave a blank line between paragraphs*');
readfile(listline , totalline);
add(listline , totalline);
split(listline , totalline , listword , totalword);
repeat
writeln;
writeln('Menu');
writeln('1. Frequencies of a letter');
writeln('2. Frequency of a word');
writeln('3. Total number of words');
writeln('4. Total number of paragraphs');
writeln('5. Exit');
writeln;
repeat
write('Please input your choice: ');
readln(inp);
until inp in [1..5];
if inp = 1
then begin
writeln('*Please input the target word in lowercase*');
write('Please input the target letter: ');
readln(target2);
writeln('Total number of target letter in the file is ' , freletter(listword , totalword , target2) , '.');
end
else if inp = 2
then begin
writeln('*Please input the target word in lowercase*');
write('Please input the target word: ');
readln(target1);
writeln('Total number of target word in the file is ', freword(listword , totalword , target1) , '.');
end
else if inp = 3
then writeln('Total number of word is ' , totalword , '.')
else if inp = 4
then writeln('Total number of paragraph is ' , totalline , '.');
until inp = 5;
writeln('Thank you for using this program.');
end.
program task3;
var M,N:int64;
function factorial(n:int64):int64;
begin
var f:int64:=1;
for var i:int64:=2 to n do
f:=f*i;
Result:= f;
end;
function C(n,k:int64):int64;
begin
Result:= factorial(n) div factorial(k) div factorial(n-k);
end;
begin
Readln(M);
Readln(N);
Writeln(C(M+1,2)*(C(N+1,2)));
end.
var a:array [1..10000] of longint;
n,i,j,k,kmax:longint;
begin
read(n);
for i:=1 to n do
read(a[i]);
k:=1;
kmax:=-1;
for i:=1 to n do
for j:=1 to n-i do
k:=1;
begin
while (a[i]<=a[j])and(j<n) do
begin
inc(k);
inc(i);
inc(j);
end;
if (k<kmax) then kmax:=k;
end;
writeln(k);
end.
USES CRT;
VAR KB, NB : ARRAY[1..10] OF STRING;
HG, JML : ARRAY[1..10] OF LONGINT;
ADL: CHAR;
JD, X, BR : BYTE;
TOTAL, DISC, PB : REAL;
BEGIN
ADL:='Y';JD:=0;
WHILE (ADL='Y') AND (JD<=10) DO
BEGIN
CLRSCR;
GOTOXY(25,5);WRITE('ENTRY DATA PEMBELIAN');
GOTOXY(25,6);WRITE('====================');
JD:=JD+1;
GOTOXY(25, 8);WRITE('KODE BARANG :');READLN(KB[JD]);
GOTOXY(25, 9);WRITE('NAMA BARANG :');READLN(NB[JD]);
GOTOXY(25,10);WRITE('HARGA BARANG :');READLN(HG[JD]);
GOTOXY(25,11);WRITE('JUMLAH :');READLN(JML[JD]);
GOTOXY(25,12);WRITE('ADA DATA LAGI[Y/T] :');READLN(ADL);
END;
CLRSCR;
GOTOXY(1,1);WRITE('LAPORAN PEMBELIAN BARANG');
GOTOXY(1,2);WRITE('TOKO PEISTAR KOMPUTER');
GOTOXY(1,3);WRITE('Jl. Jendral Sudirman No. 99 - Telpon (0760)');
GOTOXY(1,5);WRITE('--------------------------------------------------------------------------------------------- ');
GOTOXY(1,6);WRITE('| NO | KODE | NM BARANG | HARGA | JUMLAH | TOTAL | DISC | PEMBAY |');
GOTOXY(1,7);WRITE('----------------------------------------------------------------------------------------------');
{1234567890123456789012345678901234567890123456789012345678901234567890}
BR:=8;TOTAL:=0;
FOR X:=1 TO JD DO
BEGIN
GOTOXY(1,BR);WRITE('| ', X);
GOTOXY(6,BR);WRITE('|' , KB[X]);
GOTOXY(13,BR);WRITE('|' , NB[X]);
GOTOXY(27,BR);WRITE('|' , HG[X]);
GOTOXY(35,BR);WRITE('| ', JML[X]);
TOTAL:=HG[X]*JML[X];
IF TOTAL>500000 THEN DISC:=0.2*TOTAL
ELSE IF TOTAL>250000 THEN DISC:=0.15*TOTAL
ELSE IF TOTAL>100000 THEN DISC:=0.1*TOTAL
ELSE DISC:=0;
PB:=TOTAL-DISC;
GOTOXY(44,BR);WRITE('|', TOTAL:6:1);
GOTOXY(53,BR);WRITE('|' , DISC:8:1);
GOTOXY(64,BR);WRITE('|' , PB:9:1);
GOTOXY(77,BR);WRITE('|');
BR:=BR+1
END;
GOTOXY(1,BR);WRITE('-------------------------------------------------------------------------------------------');
READKEY;
END.
