Решения задач acmp.ru
Главная
Вход
Регистрация
Суббота, 26.09.2020, 18:28Приветствую Вас Гость | RSS
Меню сайта

Категории раздела
Pascal [121]
C++ [76]

Поиск

Мини-чат
200

Легкий заработок!

Статистика

Онлайн всего: 1
Гостей: 1
Пользователей: 0

Форма входа

Главная » Файлы » Pascal

В категории материалов: 121
Показано материалов: 1-10
Страницы: 1 2 3 ... 12 13 »

Сортировать по: Дате · Названию · Рейтингу · Комментариям · Загрузкам · Просмотрам
var a,b:array[0..3] of integer; 
i,j:integer; 
f:boolean; 

begin 
assign(input,'input.txt');reset(input); 
assign(output,'output.txt');rewrite(output); 
readln(a[1],a[2],a[3]); 
readln(b[1],b[2],b[3]); 
for i:=1 to 2 do 
for j:=1 to 2 do 
begin 
if a[j]>a[j+1] then 
begin 
a[0]:=a[j];a[j]:=a[j+1];a[j+1]:=a[0] 
end; 
if b[j]>b[j+1] then 
begin 
b[0]:=b[j];b[j]:=b[j+1];b[j+1]:=b[0] 
end; 
end; 
f:=false; 
for i:=1 to 3 do 
if a[i]<>b[i] then f:=true; 
if (not f) then begin writeln('Boxes are equal');halt end; 
f:=false; 
for i:=1 to 3 do 
if (a[i]<b[i]) then f:=true; 
if (not f) then begin writeln('The first box is larger than the second one');halt end; 
f:=false; 
for i:=1 to 3 do 
if (a[i]>b[i]) then f:=true; 
if (not f) then begin writeln('The first box is smaller than the second one');halt end; 
writeln('Boxes are incomparable'); 
close(output) 
end.
Pascal | Просмотров: 4597 | Загрузок: 1 | Добавил: shum | Дата: 03.07.2012 | Комментарии (0)

program c; 
var 
n,k:integer; 
begin 
assign(input,'input.txt'); 
assign(output,'output.txt'); 
reset(input);rewrite(output); 
read(n);k:=n div 5; 
case n mod 5 of 
0:write(k,' ',0); 
1:write(k-1,' ',2); 
2:write(k-2,' ',4); 
3:write(k,' ',1); 
4:write(k-1,' ',3); 
end; 
close(output) 
end. 
Pascal | Просмотров: 5114 | Загрузок: 0 | Добавил: shum | Дата: 03.07.2012 | Комментарии (0)

 program exp1; 
var f,t:text; 
a:string;d,l,chislo,c,i,k:integer; 
begin 
assign(f,'input.txt'); 
assign(t,'output.txt'); 
reset(f);rewrite(t); 
read(f,a); 
k:=1;l:=1; 
while k<=length(a) do begin 
val(a[k],c,d);chislo:=0; 
while d=0 do begin 
chislo:=chislo*10+c; 
inc(k);val(a[k],c,d);end; 
if chislo=0 
then chislo:=1; 
for i:=1 to chislo do 
if l>39 then begin l:=1;writeln(t,a[k]);end 
else begin inc(l);write(t,a[k]);end;inc(k);end; 
close(f);close(t);end.
Pascal | Просмотров: 5045 | Загрузок: 0 | Добавил: shum | Дата: 16.06.2012 | Комментарии (1)

var input,output:text;i,q,n,j,t,x,y:longint; ar:array[1..100,1..100] of longint;
begin
assign(input,'input.txt');reset(input);
assign(output,'output.txt');rewrite(output);
readln(input,n);
for i:=1 to n*2-1 do begin if i mod 2=1 then begin x:=0;y:=i+1; 
for t:=1 to i do begin inc(x);
dec(y);if (x>0) and (x<=n) and (y>0) and (y<=n) then begin inc(q);ar[x,y]:=q;end;end;end 
else begin y:=0;x:=i+1;
for t:=1 to i do begin inc(y);dec(x);if (x>0) and (x<=n) and (y>0) and (y<=n) then begin inc(q);ar[x,y]:=q;end;end;end;end;

for i:=1 to n do begin for j:=1 to n do begin write(output,ar[i,j],' ');end;writeln(output); end;

close(output);close(input);
end.
Pascal | Просмотров: 3283 | Загрузок: 0 | Добавил: shum | Дата: 16.06.2012 | Комментарии (0)

var i,ch,m,s,n:integer; 
ms:array[1..100] of longint; 

procedure sort; 
var j,i,mem:longint; 
begin 
for i:=1 to n-1 do 
for j:=1 to n-1 do 
if ms[j]>ms[j+1] 
then begin mem:=ms[j]; 
ms[j]:=ms[j+1]; 
ms[j+1]:=mem; 
end; 
end; 

begin 
assign(input, 'input.txt'); reset(input); 
assign(output, 'output.txt'); rewrite(output); 
readln(n); 
for i:=1 to n do begin 
readln(ch,m,s); 
ms[i]:=ch*3600+m*60+s; 
end; 

sort; 

for i:=1 to n do begin 
ch:=ms[i] div 3600; 
m:=ms[i] mod 3600; 
s:=m mod 60; 
m:=m div 60; 
writeln(ch,' ',m,' ',s) 
end; 
end. 
Pascal | Просмотров: 4806 | Загрузок: 0 | Добавил: shum | Дата: 15.06.2012 | Комментарии (0)

var n:longint; 
begin 
assign(input, 'input.txt'); 
reset(input); 
assign(output, 'output.txt'); 
rewrite(output); 
readln(n); 
writeln((n-1)*(n-2)) 
end.
Pascal | Просмотров: 3214 | Загрузок: 0 | Добавил: shum | Дата: 14.06.2012 | Комментарии (0)

var n,max,ch,i,i2,c,sum:longint; 
begin 
assign(input,'input.txt'); 
assign(output,'output.txt'); 
reset(input); 
rewrite(output); 
readln(n); 
max:=0; 
ch:=0; 
i2:=0; 
c:=0; 
for i:=1 to n do 
begin 
sum:=0; 
if n mod i=0 then begin 
i2:=i; 
while i2<>0 do 
begin 
c:=i2 mod 10; 
sum:=sum+c; 
i2:=i2 div 10; 
end; 
end; 
if sum> max then begin 
max:=sum; 
ch:=i; 
end; 
end; 
writeln(ch); 
close(output); 
close(input); 
end.
Pascal | Просмотров: 2576 | Загрузок: 0 | Добавил: shum | Дата: 14.06.2012 | Комментарии (0)

var 
i,n:longint; 
buf,X:extended; 
a:array[1..1000000]of extended; 

procedure Sort(L,R:Longint); 
var 

j:longint; 

begin 
i:=L; j:=R; X:=a[(i+j)shr 1]; 
repeat 
while a[i]<X do inc(i); 
while a[j]>X do dec(j); 
if i<=j then begin 
buf:=a[i]; a[i]:=a[j]; a[j]:=buf; 
inc(i); dec(j); 
end; 
until i>j; 
if i<R then Sort(i,R); 
if j>L then Sort(L,j); 
end; 

begin 
assign(input,'input.txt'); 
assign(output,'output.txt'); 
reset(input); 
rewrite(output); 
read(input,n); 
for i:=1 to n do read(input,a[i]); 
sort(1,n); 
for i:=1 to n do write(output,a[i]:0:0,' '); 
close(output); 
close(input); 
end. 
Pascal | Просмотров: 2402 | Загрузок: 0 | Добавил: shum | Дата: 14.06.2012 | Комментарии (0)

var i,j,k,n,l:longint; 
x:Array[1..10000] of integer; 

begin 
assign(input,'input.txt');reset(input); 
assign(output,'output.txt');rewrite(output); 
readln(n); 
x[1]:=1; 
l:=1; 
for i:=1 to n do 
begin 
for k:=1 to l do 
x[k]:=x[k]*2; 
for j:=1 to l do 
if x[j]>9 then 
begin 
x[j]:=x[j] mod 10; 
inc(x[j+1]); 
end; 
if x[l+1]<>0 then inc(l); 

end; 

for i:=l downto 1 do 
write(x[i]); 
close(input); 
close(output); 
end. 
Pascal | Просмотров: 2098 | Загрузок: 0 | Добавил: shum | Дата: 14.06.2012 | Комментарии (0)

Var a,b,c,maxln:ansistring; 
q:char; 
max: longint; 
begin 
Assign(input,'input.txt'); 
Assign(output,'output.txt'); 
Reset(input); 
Rewrite(output); 
Read(q); 
a:=''; 
b:=''; 
c:=''; 
While q<>' ' do 
begin 
a:=a+q; 
Read(q); 
end; 

Read(q); 
While q<>' ' do 
begin 
b:=b+q; 
Read(q); 
end; 

Read(q); 
While not eoln do 
begin 
c:=c+q; 
Read(q); 
end; 
c:=c+q; 
if length(a)>length(b) then maxln:=a 
else if length(a)<length(b) then maxln:=b 
else if a>b then maxln:=a 
else maxln:=b; 
if length(c)>length(maxln) then maxln:=c 
else if (length(c)=length(maxln)) and (c>maxln) then maxln:=c; 


Writeln(maxln); 
Close(input); 
Close(output); 
end.
Pascal | Просмотров: 4658 | Загрузок: 1 | Добавил: shum | Дата: 14.06.2012 | Комментарии (0)

Это интересно!


Copyright MyCorp © 2020