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 prospech;
uses crt;
var zspravanie,znajhorsia:integer;
var priemer:real;
var a,b,c:boolean;
begin
clrscr;
writeln('zadajte znamku zo spravania');
readln(zspravanie);
writeln('zadajte priemer znamok');
readln(priemer);
writeln('zadajte najhorsiu znamku');
readln(znajhorsia);
a:=false;
b:=false;
c:=false;
if zspravanie=1 then if (znajhorsia<=2) and (priemer<=1.5) then begin writeln('prospel s vyznamenanim'); a:=true; end
else if (znajhorsia<=3) and (priemer<=2) then begin writeln('prospel velmi dobre'); b:=true; end;
if (zspravanie=2) or (zspravanie=3) then if (znajhorsia<=4) and (b=false) and (a=false) then begin writeln('prospel'); c:=true; end;
if (a=false) and (b=false) and (c=false) then writeln('neprospel');
readln;
end.
program Project;
uses SysUtils, CRT;
type
TStringArray = array of string;
function needsSwap(list: array of integer; start: integer; current: integer): boolean;
var
i: integer;
begin
for i:=start to current-1 do
if list[i] = list[current] then
exit(false);
exit(true);
end;
procedure swap(var list: array of integer; pos1, pos2: integer);
var
temp: integer;
begin
temp := list[pos1];
list[pos1] := list[pos2];
list[pos2] := temp;
end;
procedure findPermutations(list: array of integer; index: integer; n: integer;
var permutations: TStringArray);
var
i: integer;
num: string;
begin
if (index >= n) then
begin
SetLength(permutations, Length(permutations)+1);
for i in list do
num+=IntToStr(i);
permutations[high(permutations)] := num;
exit;
end;
for i:=index to n-1 do
if needsSwap(list, index, i) then
begin
swap(list, index, i);
findPermutations(list, index+1, n, permutations);
swap(list, index, i);
end;
end;
procedure findPermutations(list: array of integer; out combinations: TStringArray);
begin
SetLength(combinations, 0);
findPermutations(list, 0, Length(list), combinations);
end;
procedure getPossibleCombos(numbers: string;
out combinations: TStringArray);
var
i: char;
number: integer;
numbersList: array of integer;
begin
SetLength(numbersList, 0);
for i in numbers do
begin
number := ord(i)-48;
if ((number < 0) or (number > 9)) then
exit;
SetLength(numbersList, Length(numbersList)+1);
numbersList[high(numbersList)] := number;
end;
findPermutations(numbersList, combinations);
end;
function exitLoopYesNo(prompt: string;
inverse: boolean = false;
default: boolean = false;
askInput: boolean = true): boolean;
var
inp: char;
begin
if not askInput then exit(false);
write(prompt+' (Y/N) ');
inp := ReadKey;
case inp of
'y', 'Y': result := not inverse;
'n', 'N': result := inverse;
else result := default
end;
writeln(inp);
end;
const
outputLen = 40;
var
numbers: string;
output: TStringArray;
i: integer;
begin
repeat
write('Enter numbers: ');
readln(numbers);
getPossibleCombos(numbers, output);
i:=0;
while i < length(output) do
begin
if (i<>0) then
write(', ');
if (i mod (outputLen div length(numbers)) = 0) then
writeln;
write(output[i]);
i+=1;
end;
writeln;
until exitLoopYesNo('Run Again?', true, false, Length(output)>0);
readln;
end.
Program Houses(output);
Const max_houses = 23;
Type hptr = ^house;
house = Record
pos, min, max : real;
prev, next: hptr;
end;
Var street : hptr;
break : boolean;
procedure init;
var h : hptr;
begin {init}
street := new(hptr);
street^.pos := 0;
street^.min := 0;
street^.max := 0.5;
street^.prev := nil;
h := new(hptr);
street^.next := h;
h^.pos := 1;
h^.min := 0.5;
h^.max := 1;
h^.next := nil;
h^.prev := street;
break := false;
end; {init}
procedure show(street: hptr);
var p : integer;
h : hptr;
begin {show}
writeln;
p := 1;
h := street;
while h <> nil do
begin
writeln(p:2, ': ', h^.pos:6:3, ' ', h^.min:6:3, ':', h^.max:6:3);
h := h^.next;
p := p+1;
end;
writeln;
end; {show}
function legal(street: hptr; cur_pos, n: integer): boolean;
var res : boolean;
h : hptr;
k : integer;
low, high : real;
begin {legal}
res := true;
h := street;
k := cur_pos;
while h <> nil do
begin
low := (k-1)/n;
high := k/n;
if (h^.max < low) or (h^.min > high) or (h^.max < h^.min) then res := false;
{update house's limits to current n}
if h^.min < low then h^.min := low;
if h^.max > high then h^.max := high;
k := k+1;
h := h^.next;
end; {while h <> nil}
legal := res;
end; {legal}
function give_head(h: hptr): hptr;
begin {copy}
while h^.prev <> nil do h := h^.prev;
give_head := h;
end; {copy}
function clone(current_pos: hptr): hptr;
var head, h,
follow, pos : hptr;
begin {clone}
h := nil;
head := give_head(current_pos);
while head <> nil do
begin
follow := h;
h := new(hptr);
h^.pos := head^.pos;
h^.min := head^.min;
h^.max := head^.max;
h^.prev := follow;
if follow <> nil then
follow^.next := h;
h^.next := nil;
if head = current_pos then
pos := h;
head := head^.next;
end;
clone := pos;
end; {clone}
procedure expand(n: integer; street: hptr); {expands n-1-legal street to n}
Var h, c, nh : hptr;
k : integer;
high, low : real;
fail : boolean;
begin {expand}
if n > max_houses then
begin
writeln('Success at ', n-1, ':');
show(street); writeln;
writeln('legal = ', legal(street, 1, n-1));
break := true;
end
else
begin
h := street^.next;
k := 2;
fail := false;
while (h <> nil) and (not fail) and (not break) do
begin
low := (k-1)/n;
high := k/n;
if h^.max >= high then {insert possible}
begin {insert new house into clone of street, then expand if legal}
c := clone(h);
nh := new(hptr);
nh^.min := low;
nh^.max := high;
nh^.pos := (low + high) / 2;
nh^.prev := c^.prev;
c^.prev := nh;
nh^.next := c;
nh^.prev^.next := nh;
c := nh;
if legal(c, k, n) then expand(n+1, give_head(c));
if break then write(k, ' ');
end;
if h^.max < low then fail := true;
{update house's limits to current n}
if h^.min < low then h^.min := low;
if h^.max > high then h^.max := high;
if h^.min > h^.max then
fail := true
else
h^.pos := (h^.min + h^.max) / 2;
k := k+1;
h := h^.next;
end; {while h <> nil}
end; {else}
dispose(street);
if n = 3 then
begin
writeln;
writeln('READY.');
end;
end; {expand}
begin {main}
init;
expand(3, street);
end.
program trideni;
uses crt;
var a,b,c,d: integer;
i: array[0..10] of integer;
j: array[0..2] of integer;
begin clrscr;
randomize;
for a:=1 to 6 do i[a]:= random(8)+1;
for a:=1 to 6 do write(i[a], ' ');
a:=1;
c:=1;
repeat repeat j[0]:=i[a];
j[1]:=i[a+1];
if j[1]<j[0] then begin i[a]:=j[1]; i[a+1]:=j[0]; end;
a:=a+1;
until a=6;
c:=c+1;
a:=1;
until c=8;
writeln;
writeln;
for a:=1 to 6 do write(i[a], ' ');
readln();
end.
program Posters;
type
Post = record
x, y :int64;
w, h, next, prev :longint
end;
var N, L, i :longint;
P :array[-1..3000] of longint;
function max(a, b :int64) :int64;
begin
if a > b then exit (a)
exit (b)
end;
begin
readln(N,L);
with P[1] do
begin
readln(w,h);
x := 0;
y := 0;
next := -1;
prev := 0
end;
with P[0] do
begin
x := 0; y := P[1].h;
w := 0; h := 0;
next := 1; prev := -1
end;
with P[-1] do
begin
x := P[1].h; y := 0;
w := 0; h := 0;
next := 0; prev := 1
end;
for i := 2 to N do
begin
readln(P[i].w,P[i].h);
k := 0;
while (k >= 0) and (P[P[k].next].y + P[P[k].next].h + P[i].h > L) do
k := P[k].next;
P[i].x := P[k].x + P[k].w;
P[i].y := P[k].y;
P[i].next := P[k].next;
P[i].prev := k;
P[k].next := i;
P[0].y := max(P[0].y,P[i].y + P[i].h);
P[-1].x := max(P[-1].x,P[i].x + P[i].w);
k := 0;
while k >= 0 do
end;
end;
Program ascii;
var r: char;
n: integer;
x: string;
ch: array [1..5]
begin
readln(x);
n:=ord(x)+4;
if n>122 then
n:=n-122+65;
r:=chr(n);
writeln(r);
end.
Program HelloWorld(output);
var
n, t, h, e:integer;
roman_no: string;
roman: array[1..7] of string;
no: array[1..6] of integer;
begin
writeln('Input a postive integer <=3999.');
readln(n);
while n<=3999 do
begin
t:=n div 1000;
n:=n mod 1000;
h:=n div 100;
n:=n mod 100;
e:=n div 10;
n:=n mod 10;
end;
roman[1]:=I;
roman[2]:=V;
roman[3]:=X;
roman[4]:=L;
roman[5]:=C;
roman[6]:=D;
roman[7]:=M;
end.
Program P_postas;
var z:array[2..50,2..50] of char;
h:array[2..50,2..50] of longint;
c:array[1..50,1..2] of integer;
i,j,n,x,y,m,d:integer;
function dist(l,k:integer):real;
var
dist:=sqrt(sqr(x-l)+sqr(y-k));
end;
begin
readln(n);
for i:=1 to n do begin
for j:=1 to n do read(z[i,j]);
readln;
end;
for i:=1 to n do begin
for j:=1 to n do read(h[i,j]);
readln;
end;
m:=0;
for i:=1 to n do
for j:=1 to n do begin
if z[i,j]='P' then begin
x:=i;
y:=j;
end;
if z[i,j]='K' then begin
m:=m+1;
c[m,1]:=i;
c[m,2]:=j;
end;
end;
writeln(x,' ',y);
for i:=1 to m do writeln(c[i,1],' ',c[i,2]);
min:=dist(c[1,1],c[1,2])
x1:=c[1,1];
y1:=c[1,2];
for i:=2 to m do
d:=dist(c[i,1],c[i,2])
if d<min then begin
min:=d;
x1:=c[i,1];
y1:=c[i,2];
end;
end.
