Суббота, 18.05.2024, 19:53
Приветствую Вас Guest Member

Windows XP / 7 .

[ Новые сообщения · Участники · Правила форума · Поиск · RSS ]
  • Страница 2 из 3
  • «
  • 1
  • 2
  • 3
  • »
Архив - только для чтения
Форум <<Помощь по компьютерам>> » Новички в программировании » Помощь студентам » Решение задач
Решение задач
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.



 
Форум <<Помощь по компьютерам>> » Новички в программировании » Помощь студентам » Решение задач
  • Страница 2 из 3
  • «
  • 1
  • 2
  • 3
  • »
Поиск: