Решение задач
|
|
Admin | Дата: Среда, 20.10.2010, 22:46 | Сообщение # 16 |
Forum member
Группа: Admin
Зарегистрирован: 24.02.2010
Откуда: Цюрупинск
Пол: Мужчина
Сообщений: 691
Статус: Вне сайта
| Сумма цифр заданного числа Code 01 var A,Sum: integer; 02 begin 03 ReadLn(A); 04 Sum:=0; 05 while A > 0 do 06 begin 07 Sum:=Sum + A mod 10; 08 A:=A div 10; 09 end; 10 WriteLn(Sum); 11 end;
|
|
|
|
Admin | Дата: Среда, 20.10.2010, 22:46 | Сообщение # 17 |
Forum member
Группа: Admin
Зарегистрирован: 24.02.2010
Откуда: Цюрупинск
Пол: Мужчина
Сообщений: 691
Статус: Вне сайта
| Является ли число точным квадратом? Code 1 var A: integer; 2 begin 3 ReadLn(A); 4 if Sqr(Round(Sqrt(A)))= A then 'Yes' 5 else 'No'; 6 end;
|
|
|
|
Admin | Дата: Среда, 20.10.2010, 22:47 | Сообщение # 18 |
Forum member
Группа: Admin
Зарегистрирован: 24.02.2010
Откуда: Цюрупинск
Пол: Мужчина
Сообщений: 691
Статус: Вне сайта
| Простое число Code 1 i:=2; 2 while A mod i <> 0 do i:=i+1; 3 if i=A then prostoe 4 else sostavnoe;
|
|
|
|
Admin | Дата: Среда, 20.10.2010, 22:47 | Сообщение # 19 |
Forum member
Группа: Admin
Зарегистрирован: 24.02.2010
Откуда: Цюрупинск
Пол: Мужчина
Сообщений: 691
Статус: Вне сайта
| Максимальное из 3х чисел. Code 01 var A,B,C,Res: extended; 02 begin 03 ReadLn(A); 04 ReadLn(B); 05 ReadLn(C); 06 if (A > <img src="http://s21.ucoz.net/sm/24/cool.gif" border="0" align="absmiddle" alt="cool"> and (A > C) then Res:=A 07 else if B > C then Res:=B 08 else Res:=C; 09 WriteLn(Res); 10 end;
|
|
|
|
Admin | Дата: Среда, 20.10.2010, 22:47 | Сообщение # 20 |
Forum member
Группа: Admin
Зарегистрирован: 24.02.2010
Откуда: Цюрупинск
Пол: Мужчина
Сообщений: 691
Статус: Вне сайта
| Возведение X в степень Y при помощи Ln Code 1 var X,Y,Step: extended; 2 begin 3 ReadLn(X); 4 ReadLn(Y); 5 Step:=Exp(Y*Ln(X)); 6 end;
|
|
|
|
Admin | Дата: Среда, 20.10.2010, 22:48 | Сообщение # 21 |
Forum member
Группа: Admin
Зарегистрирован: 24.02.2010
Откуда: Цюрупинск
Пол: Мужчина
Сообщений: 691
Статус: Вне сайта
| Возведение X в степень Y умножением Code 01 procedure TForm1.ResButtonClick(Sender: TObject); 02 var 03 x,y,Res:int64; 04 i: integer; 05 begin 06 x:=StrToInt(XEdit.Text); 07 y:=StrToInt(YEdit.Text); 08 Res:=1; 09 for i:=1 to y do 10 begin 11 Res:=Res*x; 12 end; 13 ResLabel.Caption:=IntToStr(Res); 14 end;
|
|
|
|
Admin | Дата: Среда, 20.10.2010, 22:49 | Сообщение # 22 |
Forum member
Группа: Admin
Зарегистрирован: 24.02.2010
Откуда: Цюрупинск
Пол: Мужчина
Сообщений: 691
Статус: Вне сайта
| Факториал Code 01 procedure TForm1.ResButtonClick(Sender: TObject); 02 var 03 i,N,F:integer; 04 begin 05 N:=StrToInt(NEdit.Text); 06 F:=1; 07 for i:=1 to N do 08 begin 09 F:=F*i; 10 end; 11 ResLabel.Caption:=IntToStr(F); 12 F:=1; 13 i:=1; 14 while i <= N do 15 begin 16 F:=F*i; 17 i:=i+1; 18 end; 19 WhLabel.Caption:=IntToStr(F); 20 F:=1; 21 i:=1; 22 if N = 0 then N:=1; 23 Repeat 24 F:=F*i; 25 i:=i+1; 26 until i=N+1; 27 RpLabel.Caption:=IntToStr(F); 28 end;
|
|
|
|
Admin | Дата: Среда, 20.10.2010, 22:49 | Сообщение # 23 |
Forum member
Группа: Admin
Зарегистрирован: 24.02.2010
Откуда: Цюрупинск
Пол: Мужчина
Сообщений: 691
Статус: Вне сайта
| Квадратное уравнение Code 01 procedure TForm1.ResButtonClick(Sender: TObject); 02 var 03 a,b,c,D,x,x2,temp: extended; 04 begin 05 a:=StrToFloat(AEdit.Text); 06 b:=StrToFloat(BEdit.Text); 07 c:=StrToFloat(CEdit.Text); 08 D:=Sqr(b)- 4*a*c; 09 if D = 0 then 10 begin 11 temp:=2*a; 12 x:= -b/temp; 13 ResLabel.Caption:='X = '+FloatTostr(x); 14 end else 15 begin 16 if D > 0 then 17 begin 18 x:=-b+Sqrt(D); 19 x2:=-b-Sqrt(D); 20 temp:=2*a; 21 x:=x/temp; 22 x2:=x2/temp; 23 ResLabel.Caption:='X1 = '+FloatTostr(x)+' X2= '+FloatTostr(x2); 24 end else 25 begin 26 ResLabel.Caption:='Reshenija net'; 27 end; 28 end; 29 end;
|
|
|
|
Admin | Дата: Среда, 20.10.2010, 22:49 | Сообщение # 24 |
Forum member
Группа: Admin
Зарегистрирован: 24.02.2010
Откуда: Цюрупинск
Пол: Мужчина
Сообщений: 691
Статус: Вне сайта
| Сумма 10 символов числа Pi Code 01 program Pi10; 02 {$APPTYPE CONSOLE} 03 uses 04 SysUtils; 05 06 var 07 i,sum : integer; 08 temp,p: extended; 09 begin 10 p:=Pi; 11 temp:=p; 12 sum:=0; 13 for i:=1 to 10 do 14 begin 15 p:=Trunc(p); 16 sum:=sum + Trunc(p); 17 temp:=temp - p; 18 p:=temp*10; 19 temp:=p; 20 end; 21 writeln(sum); 22 readln; 23 end.
|
|
|
|
Admin | Дата: Среда, 20.10.2010, 22:50 | Сообщение # 25 |
Forum member
Группа: Admin
Зарегистрирован: 24.02.2010
Откуда: Цюрупинск
Пол: Мужчина
Сообщений: 691
Статус: Вне сайта
| Задача 1019 Даны коордиинаты центра круга и одной из точек на окружности. Найти площадь круга. Code 01 program Home1; 02 {$APPTYPE CONSOLE} 03 uses 04 SysUtils; 05 var 06 x,y,x1,y1,s: extended; 07 begin 08 Writeln('Input X,Y,X1,Y1'); 09 ReadLn(x,y,x1,y1); 10 s:=Pi*(Sqr(x1-x)+Sqr(y1-y));{ r:=Sqrt(Sqr(x1-x)+Sqr(y1-y)); s:=Pi*Sqr(r);} 11 Write('S = ',s:6:2); 12 Readln; 13 end.
|
|
|
|
Admin | Дата: Среда, 20.10.2010, 22:51 | Сообщение # 26 |
Forum member
Группа: Admin
Зарегистрирован: 24.02.2010
Откуда: Цюрупинск
Пол: Мужчина
Сообщений: 691
Статус: Вне сайта
| Задача 2010 Даны две различные прямые y=k1*x+b1 и y=k2*x+b2. Найти точку пересечения данных прямых. Code 01 program Project1; 02 {$APPTYPE CONSOLE} 03 uses 04 SysUtils; 05 06 var 07 k1,k2,b1,b2,x,y,m: extended; 08 begin 09 readln(k1,b1,k2,b2); 10 m:=k2-k1; 11 if (m <= -10e-9) or (m >= 10e-9) then 12 begin 13 x:=(b2-b1)/(k1-k2); 14 y:=k1*x+b1; 15 writeln(x:5:2,y:5:2); 16 end else 17 begin 18 writeln('no'); 19 end; 20 readln; 21 end.
|
|
|
|
Admin | Дата: Среда, 20.10.2010, 22:51 | Сообщение # 27 |
Forum member
Группа: Admin
Зарегистрирован: 24.02.2010
Откуда: Цюрупинск
Пол: Мужчина
Сообщений: 691
Статус: Вне сайта
| Задача 3026 Вводится номер года n. Определить, каким днем недели является 1 января данного года, если 1 января 1900 года - понедельник (для решения этой задачи заметим, что в случае, когда год невисокосный, 1 января следующего года сдвигается на 1 день недели, а если год високосный -то на 2). Високосным является год, делящийся на 4, но 1900 - не високосный Code 01 program Project1; 02 {$APPTYPE CONSOLE} 03 uses 04 SysUtils; 05 06 var 07 i,god,res,den: integer; 08 begin 09 readln(god); 10 den:=0; 11 for i:=1901 to god do 12 begin 13 if (i-1) mod 4 = 0 then den:=den+1; 14 den:=den+1; 15 end; 16 if god =1900 then den:=1; 17 res:=den mod 7; 18 if res =0 then res:=7; 19 writeln(res); 20 readln; 21 end.
|
|
|
|
Admin | Дата: Среда, 20.10.2010, 22:52 | Сообщение # 28 |
Forum member
Группа: Admin
Зарегистрирован: 24.02.2010
Откуда: Цюрупинск
Пол: Мужчина
Сообщений: 691
Статус: Вне сайта
| Задача 4014 n-значное натуральное число является числом Армстронга, если сумма его цифр, возведенных в n-ю степень, совпадает с самим числом. Даны числа a и b. Найти количество чисел Армстронга в диапазоне [a;b]. Code 01 program Project2; 02 {$APPTYPE CONSOLE} 03 uses 04 SysUtils; 05 06 var 07 i,j,k,a,b,rest,temp,rt,res: integer; 08 n,d0,d: integer; 09 mas: array[0..255] of integer; 10 begin 11 readln(a,b); 12 Res:=0; 13 for i:=a to b do 14 begin 15 n:=0; 16 d:=i; 17 repeat 18 d0:=d mod 10; 19 inc(n); 20 mas [n-1]:=d0; 21 d:=d div 10; 22 until d = 0; 23 rest:=0; 24 for j:=1 to n do 25 begin 26 rt:=1; 27 for k:=1 to n do 28 begin 29 temp:=mas[j-1]; 30 rt:=rt*temp; 31 end; 32 rest:=rest+rt; 33 end; 34 if rest =i then inc(res); 35 end; 36 writeln(Res); 37 readln; 38 end.
|
|
|
|
Admin | Дата: Среда, 20.10.2010, 22:52 | Сообщение # 29 |
Forum member
Группа: Admin
Зарегистрирован: 24.02.2010
Откуда: Цюрупинск
Пол: Мужчина
Сообщений: 691
Статус: Вне сайта
| Дана строка. Словом в ней назовем последовательность подряд идущих латинских букв (больших или маленьких). Подсчитать количество слов в строке. Code 01 program Project1; 02 {$APPTYPE CONSOLE} 03 uses 04 SysUtils; 05 06 var 07 s: string; 08 i,sc,wc,l: integer; 09 begin 10 readln(s); 11 sc:=0; 12 wc:=0; 13 l:=length(s); 14 for i:=1 to l do 15 begin 16 case s[i] of 17 'A'..'Z': inc(sc); 18 'a'..'z': inc(sc); 19 else if sc > 0 then 20 begin 21 inc(wc); 22 sc:=0; 23 end; 24 end; 25 end; 26 if sc > 0 then inc(wc); 27 writeln(wc); 28 readln; 29 end.
|
|
|
|
Admin | Дата: Среда, 20.10.2010, 22:53 | Сообщение # 30 |
Forum member
Группа: Admin
Зарегистрирован: 24.02.2010
Откуда: Цюрупинск
Пол: Мужчина
Сообщений: 691
Статус: Вне сайта
| Дана последовательность целых чисел ai. Построить новую последовательность, содержащую элементы исходной последовательности, равными двойке в четной степени. Code 01 program Project1; 02 {$APPTYPE CONSOLE} 03 uses 04 SysUtils; 05 06 var 07 vvod: array [1..255] of integer; 08 i,a,j,x,y,z: integer; 09 begin 10 i:=1; 11 repeat 12 readln(a); 13 vvod[i]:=a; 14 inc(i); 15 until a=0; 16 for j:=1 to i-2 do 17 begin 18 y:=2; 19 repeat 20 z:=1; 21 for x:=1 to y do 22 begin 23 z:=z*2; 24 end; 25 y:=y+2; 26 if vvod[j]=z then writeln(z); 27 until vvod[j]<=z; 28 end; 29 readln; 30 end.
|
|
|
|