Форум программистов, компьютерный форум, киберфорум
Наши страницы
Pascal (Паскаль)
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.55/110: Рейтинг темы: голосов - 110, средняя оценка - 4.55
SAZl
2 / 9 / 0
Регистрация: 12.10.2011
Сообщений: 173
1

Примеры решенных задач

14.10.2011, 18:19. Просмотров 21944. Ответов 6
Метки нет (Все метки)

Вот решил выложить программы с лабораторных работ:

1) Сгенерировать одномерный массив и вывести на экран, далее представить его в виде двумерного массива в котором все нулевые элементы расположены на местах с нечетными индексами строк и столбцов. Вывести элемент массива (двумерного) который запрашивает пользователь по номеру.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
program one;
uses crt;
var
   i,j,x,y,c,p: integer;
   ch:boolean;
   a: array [1..75] of integer;
function NewIndex (x1,y1:integer): integer;
var ind, res: integer;
begin
    res := 0;
    if (x1 mod 2 = 0) or (y1 mod 2 = 0) then
       begin
         for ind := 1 to x1 do begin
          if (ind mod 2 <> 0) and (ind <> x1) then res:= res + y div 2;
          if (ind mod 2 = 0) and (ind <> x1) then res := res + y;
          if (ind mod 2 <> 0) and (ind = x1) then res:= res + y1 div 2;
          if (ind mod 2 = 0) and (ind = x1) then res := res + y1;
         end;
   end;
   NewIndex := res;
end;
function PutTab (x1,y1,p:integer): integer;
begin
     PutTab := 0;
     if NewIndex(x1,y1) <> 0 then begin
                             a[NewIndex(x1,y1)] := p;
                             PutTab := p;
 
     end;
end;
function GetTab (x1,y1:integer): integer;
begin
     GetTab:= 0;
     if NewIndex(x1,y1) <> 0 then GetTab :=a[NewIndex(x1,y1)];
end;
begin
 
  clrscr;
  writeln ('Input size two-dimensional massiv: ');
  randomize;
  {$I-}
  repeat
  x:=0;
  y:=0;
  readln (x,y);
 
  if IOResult = 0 then begin
  if (x>0) and (y>0) and (x<=10) and (y<=10) then ch := true
 
                     else writeln ('Wrong input data');
  end else writeln ('Wrong Input data');
  until ch = true;
 
  ch := false;
  writeln ('Inner presentation:');
  for i := 1 to x do
     for j := 1 to y do begin
          if NewIndex(i,j) <> 0 then begin
          a[NewIndex(i,j)] := random(98)+1;
          write (a[NewIndex(i,j)], ' ');
          end;
      end;
  writeln;
  writeln ('Logical presentation:');
  for i := 1 to x do begin
           for j := 1 to y do begin
           if NewIndex (i,j) <> 0 then write (a[NewIndex(i,j)], ' ')
                                       else write ('0', ' ');
           end;
           writeln;
  end;
  writeln;
  repeat
  writeln ('1) Get element');
  writeln ('2) Exit');
  readln (c);
  if ioresult = 0 then begin
  case c of 1: begin
               repeat
               i:=0; j:=0;
 
               readln (i,j);
               if IOResult = 0 then begin
               if (i>0) and (j>0) and (i<=10) and (j<=10) then ch := true
                     else writeln ('Wrong input data');
               end else writeln ('Wrong input data');
               until ch = true;
 
               ch := false;
               writeln (GetTab(i,j));
               readln;
  end;
            2: halt(1);
            else begin writeln ('Wrong input data');
                       readln;
            end;
  end;
  end else writeln ('Wrong input data');
  until c = 4;
 
end.
2) Функция Center(s1,s2,l). Центрирование - расположение строки s1 в середине строки s2 длины l.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
program MYstring;
var len1, len2:byte;
    s1, s2: string;
function center (s1,s2:string; len1,len2:byte):string;
var res:string;
    ind,i1,i2:integer;
 
begin
  res := s1;
  res[0] := chr(len1+len2);
  ind := len1 div 2;
  i1 := len1+len2;
  i2 := len1;
  repeat
         res[i1] := res[i2];
         dec(i2); dec(i1);
  until i2=ind;
  for i1 := 1 to len2 do res[ind+i1] := s2[i1];
  center := res;
end;
begin
     repeat
     writeln('Input string:');
     readln (s2);
     readln (s1);
     len1 := ord(s1[0]);
     len2 := ord(s2[0]);
     if len1+len2>255 then writeln ('Wrong input data');
     until len1+len2 <= 255;
     writeln (center(s1,s2,len1,len2));
     writeln ('Enter from EXIT');
     readln;
end.
Может кому пригодится!

Добавлено через 20 часов 15 минут
3) Дано 100 целых чисел от 1 до 50. Определить сколько среди них чисел Фибоначчи и сколько чисел,
первая значищая цифра в дисятичной записи которых является 1 или 2.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Program Primer;
const f:set of byte=[0,1,2,3,5,8,13,21,34];
          N=10;
var  i,k,count_f,count_n:integer;
       a:array [1..100] of integer;
 
begin
         count_f:=0;
     count_n:=0;
 
         for i:=1 to N do
     begin
         read(a[i]);
     end;
 
     for i:=1 to N do
     begin
          if a[i] in f then
             inc(count_f);
     end;
 
     for i:=1 to N do
     begin
         if a[i] in [1,2,10..29] then
            inc(count_n);
     end;
 
     writeln;
     writeln('Fibonachi - ',count_f);
     readln;
     writeln('Numbers 1,2 - ',count_n);
     readln;
end.
4) Даны целые числа а1,...,аn (могут быть повторяющиеся). Вывести на печать все числа,
которые входят в последовательность по одному разу.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Program primer;
type set_int=set of byte;
var a:set_int;
    i,N,k,min,max:integer;
begin
      writeln('input number of integer(less than 256)');
    read(N);
 
    writeln('input min and max number in set');
    read(min,max);
 
    for i:=1 to N do
    begin
      read(k);
            a:=a+[k];
    end;
 
    for i:= min to max do
    begin
      if i in a then
            write(1, ' ');
    end;
 
    readln;
end.
5) Дана непустая последовательность слов из строчных русских букв, между соседними
словами - запятая, за последним словом - точка. Напечатать в алфавитном порядке все
гласные буквы, которые входят в каждое слово.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Program Primer;
const vowels:set of char=['*', 'Ґ', 'Ё', '®', 'г', 'л', 'н', 'о', 'п'];
var tmp_char:set of char;
    s,tmp:string;
    i,k:integer;
begin
      repeat
          writeln('input any string');
          readln(s);
    until s <> '';
 
    delete(s,length(s),1);
        s:=s+',';
 
    while pos(',',s) > 0 do
    begin
        k:=pos(',',s);
        tmp:=copy(s, 1, k-1);
        s:=copy(s,k+1,length(s));
        write(tmp, ' = ');
        for i:=1 to length(tmp) do
        begin
            if (tmp[i] in vowels) and not(tmp[i] in tmp_char) then
            begin
                write(tmp[i]);
                tmp_char:= tmp_char + [tmp[i]];
            end;
        end;
        writeln;
        tmp_char:=[];
    end;
    readln;
end.
Добавлено через 20 минут
6) Простейшие алгоритмы сортировки: сортировка «прямого выбора», сортировка «двоичного включения», сортировка «обмена» (метод пузырька); оценка ефективности всех сортировок.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
Program Metodi_Sort;
uses crt,dos;
const n=15;
type mas=array [1..n] of integer;
var A,B:mas;
    h1,h2,m2,m1,s1,s2,ms1,ms2:word;
    t1,t2,t:longint;
Procedure Input (var X:mas; m:integer);
var i:integer;
begin
randomize;
for i:=1 to m do
      X[i]:=random(15);
end;
Procedure Output (X:mas; m:integer);
var i:integer;
begin
   writeln;
   for i:=1 to m do
          write(x[i],' ');
   writeln;
end;
Procedure Pyzirek (var X:mas; m:integer); {metod Pyzirka}
var i,j,y:integer;
begin
   for i:=2 to m do
   for j:=m downto i do
       if x[j-1]>x[j] then begin
           y:=x[j-1];
           x[j-1]:=x[j];
           x[j]:=y;
   end;
end;
Procedure Insertion (var X:mas; m:integer); {metod Prymogo vklucheniy}
var
  i,j,left,right,y: integer;
begin
  for i:=2 to m do
  begin
    y:=X[i];
    left:=1;
    right:=i-1;
    while (left<=right) do
    begin
      m:=(left+right) div 2;
      if y<X[m] then right:=m-1
                else left:=m+1;
    end;
    for j:=i-1 downto left do
    X[j+1]:=X[j];
    X[left]:=y;
  end;
end;
Procedure Selection (var X:mas; m:integer); {metod prymogo vibora}
var
  i, j, k, y:integer;
begin
  for i:=1 to m-1 do
  begin
    k:=i; y:=X[i];
    for j:=i+1 to m do
      if X[j]<y then
      begin
        k:=j;
        y:=X[j];
      end;
    X[k]:=X[i];
    X[i]:=y;
  end;
end;
begin
clrscr;
write('Massiv:');
Input(A,n);
Output(A,n);
B:=A;
writeln;
write('Metod Pyzirka');
gettime(h1,m1,s1,ms1);
Pyzirek(A,n);
gettime(h2,m2,s2,ms2);
t1:=h1*360000+m1*6000+s1*100+ms1;
t2:=h2*360000+m2*6000+s2*100+ms2;
t:=abs(t2-t1);
Output(A,n);
write('Time: ',t);
A:=B;
writeln;
writeln;
write('Metod Dvoichnogo Vklycheniy');
gettime(h1,m1,s1,ms1);
Insertion(A,n);
gettime(h2,m2,s2,ms2);
t1:=h1*360000+m1*6000+s1*100+ms1;
t2:=h2*360000+m2*6000+s2*100+ms2;
t:=abs(t2-t1);
Output(A,n);
write('Time: ',t);
writeln;
A:=B;
writeln;
write('Metod Prymogo Vibora');
gettime(h1,m1,s1,ms1);
Selection(A,n);
gettime(h2,m2,s2,ms2);
t1:=h1*360000+m1*6000+s1*100+ms1;
t2:=h2*360000+m2*6000+s2*100+ms2;
t:=abs(t2-t1);
Output(A,n);
write('Time: ',t);
readln;
end.
7) Даны натуральные числа n,m найти наибольший общий делитель Nod(n,m). Для рекурсивной процедуры используйте соотношение Nod(n,m)=Nod(m,r), где r – остаток от деление n на m; Пример с итерацией и рекурсией.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Program iNOD_rekursiy;
var k,l:integer;
    rez:integer;
function iNOD_1 (k1,l1:integer):integer;
var m1:integer;
begin
     m1:=k1 mod l1;
     if m1=0 then iNOD_1:=l1
             else iNOD_1:=iNOD_1(l1,m1);
end;
function iNOD_2 (k1,l1:integer):integer;
var m1:integer;
begin
   while l1>0 do begin
         m1:=k1 mod l1;
         k1:=l1;
         l1:=m1;
                 end;
iNOD_2:=k1;
end;
begin
writeln('vvedite 2 chisla ');
readln(k,l);
rez:=iNOD_1(k,l);
writeln('Iteratsia: NOD ',rez);
writeln('vvedite 2 chisla ');
readln(k,l);
rez:=iNOD_2(k,l);
writeln('Rekursiy: NOD ',rez);
readln;
end.
8) Напишите программу, которая будет содержать функции вычисления: 1) Суммы элементов квадратной матрицы; 2) Произведения элементов квадратной матрицы; 3) Поиска элемента с заданным значением в квадратной матрице.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
Program Primer;
const n=2;
      k=100;
type Array1=array[1..n,1..n] of integer;
var A:Array1;
    s,p:longint;
    t:integer;
Procedure InputRandom (var X:array1; m:integer);
var i,j:integer;
begin
randomize;
     for i:=1 to m do
        for j:=1 to m do
            X[i,j]:=random(k);
end;
Procedure OutPut (X:Array1; m:integer);
var i,j:integer;
begin
     for i:=1 to m do
        begin
          for j:=1 to m do
              write(X[i,j],' ');
              writeln;
        end;
end;
function iSum (X:Array1; m:integer):longint;
var i,j:integer;
    summa:longint;
begin
    summa:=0;
    for i:=1 to m do
        for j:=1 to m do
            summa:=summa+X[i,j];
    iSum:=summa;
end;
function iProd (X:Array1; m:integer):longint;
var i,j:integer;
    prod:longint;
begin
    prod:=1;
    for i:=1 to m do
        for j:=1 to m do
            prod:=prod*X[i,j];
    iProd:=prod;
end;
Procedure Poisk (X:Array1; m:integer; t:integer);
var
   i,j:integer;
begin
for i:=1 to m do
        for j:=1 to m do
        if x[i,j]=t then writeln('Iteratsiy: stroka ',i,' stolbets ',j);
end;
function rSum (X:Array1; i:integer; j:integer):integer;
begin
if (i=1) and (j=1) then rSum:=x[i,j]
   else
   if (j=1) then rSum:=x[i,j]+rSum(x,i-1,n)
   else rSum:=x[i,j]+rSum(x,i,j-1);
end;
function rProd (X:Array1; i:integer; j:integer):longint;
begin
if (i=1) and (j=1) then rProd:=x[i,j]
   else
   if (j=1) then rProd:=x[i,j]*rProd(x,i-1,n)
   else rProd:=x[i,j]*rProd(x,i,j-1);
end;
Procedure rPoisk (X:Array1; m:integer; t:integer);
var
   i,j:integer;
begin
for i:=1 to m do
        for j:=1 to m do
        if x[i,j]=t then writeln('Rekyrsiy: stroka ',i,' stolbets ',j);
end;
 
begin
InputRandom(A,n);
OutPut(A,n);
writeln('Vvedite element dly poiska ');
readln(t);
writeln('Poisk:');
Poisk(A,n,t);
rPoisk(A,n,t);
s:=iSum(A,n);
writeln('Iteracionnoe reshenie: summa ',s);
p:=iProd(A,n);
writeln('Iteracionnoe reshenie: proizvedenie ',p);
s:=rSum(A,n,n);
writeln('Rekyrsivnoe reshenie: summa ',s);
p:=rProd(A,n,n);
writeln('Rekyrsivnoe reshenie: proizvedenie ',p);
readln;
end.
9) Даны символьные файлы f1 и f2. Переписать с сохранением порядка следования компоненты файла f1 в f2, а компоненты f2 в f1. Использовать вспомогательный файл h.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
Program Primer;
const
 namef1='f1.txt';
 namef2='f2.txt';
 nameh='h.txt';
var
  f1,f2,h:file of char;
  s:string;
  b:char;
  i:integer;
begin
 writeln('Vvedite text y file1:');
 readln(s);
 assign(f1,namef1);
 rewrite(f1);
 for i:=1 to lenght(s) do
 begin
      b:=s[i];
      write(f1,b);
 end;
 close(f1);
 
 writeln('Vvedite text y file2:');
 readln(s);
 assign(f2,namef2);
 rewrite(f2);
 for i:=1 to lenght(s) do
 begin
      b:=s[i];
      write(f2,b);
 end;
 close(f2);
 
{ f1->h f2->f1 h->f2 }
 
  assign(h,nameh);
  rewrite(h);
  reset(f1);
 
  while not eof(f1) do
  begin
       read(f1,b);
       write(h,b);
  end;
  close(f1);
  close(h);
 
  reset(f1);
  while not eof(f1) do
  begin
       read(f1,b);
       write(b);
  end;
  writeln;
 
assign(f1,nameh);
  rewrite(f1);
  reset(f2);
 
  while not eof(f2) do
  begin
       read(f2,b);
       write(f1,b);
  end;
  close(f2);
  close(f1);
 
  reset(f2);
  while not eof(f2) do
  begin
       read(f2,b);
       write(b);
  end;
  writeln;
 
assign(f2,nameh);
  rewrite(f2);
  reset(h);
 
  while not eof(h) do
  begin
       read(h,b);
       write(f2,b);
  end;
  close(h);
  close(f2);
 
  reset(h);
  while not eof(h) do
  begin
       read(h,b);
       write(b);
  end;
  writeln;
 
 readln
end.
10) Дан файл f, компоненты которого являются целыми числами. Найти кол-во чисел среди компонентов, кол-во удвоенных нечетных чисел среди компонентов, кол-во квадратов нечетных чисел среди компонентов.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
program Primer;
uses crt;
const ran=10;
var f:file of real;
i,ch,n,x,nech,kkv,kvv,kvvv:real;kv:real;
y:longint;
 
begin
randomize;
clrscr;
writeln('vvedite kolichestvo cifr');
readln(n);
assign(f,'zad2_a');
rewrite(f);
 
for i:=0 to n-1 do
begin
x:=random(ran);
write(f,x);
end;
close(f);
reset(f);
while not eof(f) do
begin
read(f,x);
write(x,' ');
end;
writeln;
close(f);
reset(f);
while not eof(f) do
begin
read(f,x);
if x mod 2 =0 then  begin
inc(ch);
if x mod 4<>0 then
inc(nech);  end;
kv:=sqrt(x);
kvv:=trunc(kv);
if kvv mod 2 <>0 then
inc(kvvv);
 
end;
close(f);
writeln('tchetnux chisel ',ch);
writeln('ydvoenux nechetnux ',nech);
writeln('kvadratov nechetnux chisel ',kvv);
readkey;
end.
11) Выполнить задание использовав динамическую память. Текст задан массивом указателей на n строк равной длины. Если в тексте менее n строк, то последние элементы массива равны nil. Если в операции над текстом указан номер отсутствующей строки, то такая операция не возможна.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
program one;
 uses crt;
 const m=50;
 type  pstring = ^string;
       mas = array [1..m] of pstring;
 
 var   a: mas;
       i,n,j: integer;
       str: string;
       st:string;
       ch:char;
       flag:boolean;
 
  procedure transposition(var z:mas;i,j:integer);
  var s:pstring;
  begin
  if (z[i]<> nil) and (z[j]<> nil) then
   begin
   s:=z[i];
   z[i]:=z[j];
   z[j]:=s;
   end;
  end;
 
 begin
 clrscr;
 repeat
 repeat
 writeln('vvedite kol-vo strok (m>=50)');
 readln(n);
 if (n>50) or (n<0) then
  begin
  writeln('nekkoreknniy vvod');
  end;
 until (n<=50) and (n>=0);
 writeln('vvedite postrochno vash text ');
 flag:=true;
 for i:=1 to  n do
  begin
  new(a[i]);
  readln(str);
  a[i]^:=str;
  end;
 
 writeln;
 writeln('vvedite nomer stroki');
 readln(i);
 writeln('vvedite nomer stoki');
 readln(j);
 if (i<=n) and (j<=n) and (i>0) and (j>0) then
  begin
  transposition(a,i,j);
  writeln('text posle perestanovki strok');
  for i:=1 to n do
  writeln(a[i]^)
  end
 else writeln('Takoy stroki ne syshestvyet');
 for i:=1 to n do
 begin
 dispose(a[i]);
 end;
 writeln('dlya povtore najmi e');
 writeln('dlya vixoda enter');
 ch:=readkey;
 until ord(ch)<>101;
 readln;
 end.
12) Выполнить задание использовав внутреннее представление данных в виде однонаправленного списка и реализовав операции по созданию и удалению списка.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
program vvod;
 uses crt;
 type pt=^elem;
      elem=record
            data:integer;
            next:pt;
           end;
 var ptr:pt;
     i,n,k:integer;
 
  procedure init (var z:pt;k:integer);
  var
   u:pt;
  begin
  new(u);
        u^.data:=k;
        u^.next:=z;
        z:=u;
  end;
 
  procedure out(z:pt);
     begin
       while z <> nil do
        begin
        write(z^.data,' ');
        z:=z^.next;
        end;
     end;
 
  procedure del(var z:pt);
    var u:pt;
     begin
       u:=z;
       z:=z^.next;
       dispose(u);
     end;
 
  function element(var z:pt):boolean;
    var p1,p2:pt;
        ch:boolean;
   begin
   p1:=z;
   p2:=p1^.next;
   ch:=false;
   while p1<>nil do
    begin
    while p2 <> nil do
     begin
     if p1^.data=p2^.data then ch:=true;
     p2:=p2^.next;
     end;
    p1:= p1^.next;
    if p1<>nil then p2:=p1^.next;
    if ch=true then
    break;
     end;
    element:=ch;
    end;
 
 begin
 clrscr;
 writeln('vvedite kol-vo simvolov');
 readln(n);
 writeln('vvod');
 ptr:=nil;
 for i:=1 to n do
  begin
  readln(k);
  init(ptr,k);
  end;
 {writeln('spisok ');
 out(ptr);}
 if (element(ptr)) then writeln('TRUE')
 else writeln('FALSE');
 while ptr<> nil do del(ptr);
 readln;
 end.
3
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
14.10.2011, 18:19
Ответы с готовыми решениями:

Определить оценку в зависимости от количества правильно решенных задач
Определить оценку абитуриента по математике на вступительных ЭКЗА -нах , если она определяется в...

Примеры задач на массивы
Придумайте пожалуйста какую нибудь задачу на массивы и напишите её решение, ч тоб я смог...

Примеры задач на условие и цикл.
Напишите пожалуйста 2-е любые простые задачи 1-ую с условием а 2-ую с циклом! очень надо! (конечно...

Структура: Записать в файл название команды, количество решенных задач, время, потраченное на решение.
Помогите, пожалуйста. Срочно нужно. В файле 1 хранятся данные о соревнованиях по решению задач. Он...

Необходимо 5 решенных задач на основные алгоритмы
ребят есть ли у кого по 5 решенных задач по алгоритмам: линейные,разветвляющиеся и циклы...

6
odip
Эксперт С++
7169 / 3227 / 77
Регистрация: 17.06.2009
Сообщений: 14,166
14.10.2011, 19:19 2
Похоже у Puporev появился серъезный конкурент
1
SAZl
2 / 9 / 0
Регистрация: 12.10.2011
Сообщений: 173
14.10.2011, 19:27  [ТС] 3
Цитата Сообщение от odip Посмотреть сообщение
Похоже у Puporev появился серъезный конкурент
Спасибо. Но это перебор!
Я только начал изучать программирование.
P.S. Здесь буду выкладывать программы со своих лаб, как сдам так и выложу.
1
SAZl
2 / 9 / 0
Регистрация: 12.10.2011
Сообщений: 173
27.10.2011, 18:32  [ТС] 4
Даны целые числа t1,t2,...t31. Последовательность значений t1,t2,...t31 задает график температур за март месяц. Построить график температур. Отрезки прямых, лежащие выше горизонтальной прямой, соответствующей нулевой температуре, изображаются линиями, определенными пользователем. Каждый отрезок задается своим шаблоном. Отрезки, превосходящие температуру 15 градусов, рисуются сплошной утолщенной линией. Отрезки прямых, лежащие ниже горизонтальной прямой, соответствующей нулевой температуре, изображаются сплошной линией нормальной толщины. Отрезки, соответствующие температуре ниже -5 градусов, изображаются прерывистой утолщенной линией.

Значения t приведены в таблице.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
uses graph;
const Str:array[1..31] of string =('1','2','3','4','5','6','7','8',
'9','10','11','12','13','14','15','16','17','18','19','20','21','22',
'23','24','25','26','27','28','29','30','31');
var gd, gm, i: integer; style:word;
begin
Writeln('Please input your line settings:');
Readln(style);
detectgraph (gd,gm);
      initgraph (gd,gm, 'd:\bp\bgi');
SetColor(red);
line(20,0,20,getmaxy);
SetColor(yellow);
line(20,getmaxY div 2,getmaxX, getmaxY div 2);
moveto(10,getmaxy div 2);
SetColor(Green);
Outtext('0');
OuttextXY(10,0,'t');
OuttextXY(getmaxX-10,(getmaxY div 2)-10,'d');
moveto(20,getmaxy div 2);
for i:=0 to 31 do
     begin  Outtext(str[i]);
            moveto(getx+6,(getmaxy div 2)+10);
     end;
OuttextXY(10,(getmaxY div 2)-25,'5');
OutTextXY(5,(getmaxY div 2)-52,'12');
OuttextXY(5,(getmaxY div 2)-81,'21');
OuttextXY(5,(getmaxY div 2)+29,'-9');
SetColor(Magenta);
Line(20,((getmaxY div 2)-75),getmaxX,((getmaxY div 2)-75));
SetColor(Blue);
Line(20,((getmaxY div 2)+25),getmaxX,((getmaxY div 2)+25));
SetColor(white);
moveto(20,getmaxY div 2);
SetLineStyle(Userbitln,style,normwidth);
LineTo(34,((getmaxY div 2)-50));
LineTo(48,((getmaxY div 2)-75));
LineTo(62,((getmaxY div 2)-60));
LineTo(69,((getmaxY div 2)-75));
SetLineStyle(Solidln,0,thickwidth);
LineTo(76,((getmaxY div 2)-85));
LineTo(83,((getmaxY div 2)-75));
SetLineStyle(Userbitln,style,normwidth);
LineTo(90,((getmaxY div 2)-10));
Lineto(97,getmaxY div 2);
Setlinestyle(SolidLn,0,normwidth);
LineTo(104,((getmaxY div 2)+10));
Lineto(111,((getmaxy div 2)+25));
SetLineStyle(Dashedln,0,thickwidth);
LineTo(118,((getmaxY div 2)+50));
LineTo(125,((getmaxY div 2)+25));
SetLineStyle(Solidln,0,normwidth);
LineTo(132,((getmaxY div 2)+10));
Lineto(146,(getmaxY div 2));
SetlineStyle(Userbitln,style,normwidth);
LineTo(166,((getmaxY div 2)-40));
LineTo(186,((getmaxY div 2)-60));
LineTo(206,((getmaxY div 2)-70));
LineTo(216,((getmaxY div 2)-75));
SetLineStyle(Solidln,0,thickwidth);
Lineto(226,((getmaxY div 2)-85));
Lineto(236,((getmaxY div 2)-75));
SetLineStyle(Userbitln,style,normwidth);
Lineto(246,((getmaxY div 2)-55));
LineTo(266,((getmaxY div 2)-20));
Lineto(276,getmaxY div 2);
Setlinestyle(solidln,0,normwidth);
Lineto(290,((getmaxy div 2)+10));
Lineto(300,getmaxY div 2);
Setlinestyle(userbitln,style,normwidth);
Lineto(320,((getmaxY div 2)-15));
Lineto(330,getmaxY div 2);
Setlinestyle(solidln,style,normwidth);
Lineto(335,((getmaxY div 2)+25));
SetLineStyle(Dashedln,0,thickwidth);
Lineto(340,((getmaxY div 2)+30));
Lineto(345,((getmaxY div 2)+25));
Lineto(360,((getmaxY div 2)+45));
Lineto(370,((getmaxY div 2)+25));
setlinestyle(solidln,0,normwidth);
Lineto(380,getmaxY div 2);
Setlinestyle(Userbitln,style,normwidth);
Lineto(400,((GetmaxY div 2)-5));
Lineto(420,((getmaxY div 2)-35));
Lineto(440,getmaxY div 2);
Lineto(460,((getmaxY div 2)-40));
Lineto(475,((getmaxY div 2)-75));
SetLineStyle(Solidln,0,thickwidth);
Lineto(485,((getmaxY div 2)-85));
Lineto(505,((getmaxY div 2)-90));
Lineto(525,((getmaxY div 2)-80));
Lineto(540,((getmaxY div 2)-75));
SetLineStyle(userbitln,style,normwidth);
Lineto(550,((getmaxY div 2)-50));
LineTo(570,((getmaxY div 2)-30));
LineTo(590,((getmaxy div 2)-25));
LineTo(610,getmaxY div 2);
      readln;
      closegraph;
      readln;
end.
2
Миниатюры
Примеры решенных задач  
SAZl
2 / 9 / 0
Регистрация: 12.10.2011
Сообщений: 173
27.10.2011, 18:34  [ТС] 5
Задание: см. фото.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
Program Lab3;
uses Graph;
const a: array [1..3] of word = (3,0,2);
var adapter, mode, i, max, j: integer;
    f: text;
    s: string;
    FontF: file;
    FontP,FontP1: pointer;
Begin
    assign(f, 'strok.txt');
    rewrite(f);
    Writeln('Please input 15 strings:');
    for i:=1 to 15 do
    begin
        Readln(s);
        Writeln(f,s);
    end;
    close(f);
    assign(FontF, 'd:\bp\bgi\sans.chr');
    reset(FontF, 1);
    GetMem(FontP, FileSize(FontF));
    BlockRead(FontF, FontP^, FileSize(FontF));
    if RegisterBGIFont(FontP) < 0 then
    begin Writeln('Register error'); halt(1); end;
    assign(FontF, 'd:\bp\bgi\litt.chr');
    reset(FontF, 1);
    GetMem(FontP1, FileSize(FontF));
    BlockRead(FontF, FontP1^, FileSize(FontF));
    if RegisterBGIFont(FontP1) < 0 then
    begin Writeln('Register error'); halt(1); end;
    adapter:=9;
    mode:=2;
    InitGraph(adapter,mode,'d:\bp\bgi\egavga.bgi');
    for j:=1 to 3 do
    begin
    SetActivePage(1);
    reset(f);
    SetTextStyle(DefaultFont, HorizDir, 2);
    case a[j] of
    3: OutText('SansSerif Font:');
    0: OutText('Default Font:');
    2: OutText('Little Font:');
    end;
    moveTo(0,gety);
    SetTextStyle(a[j],HorizDir,1);
    SetTextJustify(LeftText,TopText);
    for i:=1 to 10 do
    begin
        Readln(f,s);
        outtext(s);
        moveTo(10, GetY+TextHeight(s)+2);
    end;
    moveTo(30,GetMaxY);
    SetTextStyle(a[j],VertDir,1);
    SetTextJustify(LeftText,BottomText);
    max:=0;
    for i:=13 to 15 do
    begin
        Readln(f,s);
        outtext(s); if TextWidth(s)>max then max:=TextWidth(s);
        moveTo(GetX+20, GetY);
    end;
    moveTo((getmaxX div 2),30);
    SetTextStyle(a[j],HorizDir,1);
    SetTextJustify(LeftText,TopText);
    SetUserCharSize(1,2,3,2);
    for i:=11 to 12 do
    begin
         Readln(f,s);
         OutText(s);moveTo((getmaxX div 2),gety+(textheight(s)));
    end;
    close(f);
    moveTo(0, GetY+20);
    SetVisualPage(1);
    readln;
    ClearDevice;
    end;
    readln;
End.
2
Миниатюры
Примеры решенных задач  
nest1m4107
14 / 1 / 0
Регистрация: 12.03.2012
Сообщений: 3
02.04.2012, 01:26 6
Пробовал Шилда читать?
0
SAZl
2 / 9 / 0
Регистрация: 12.10.2011
Сообщений: 173
02.04.2012, 10:46  [ТС] 7
Цитата Сообщение от nest1m4107 Посмотреть сообщение
Пробовал Шилда читать?
Нет не читал.
0
02.04.2012, 10:46
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
02.04.2012, 10:46

Где можно скачать книги с примерами решениями задач задач по программированию
подскажите где можно скачать книги с примерами решениями задач задач по программированию (что бы...

Определить количество решенных задач одним человеком на турнире
Перед турниром Вася провел подготовку. Он решил А задач на циклы, В задач на массивы и C задач на...

Нужны примеры любых задач с входными и выходными данными
Мне нужны примеры любых задач на паскале с входными и выходными данными. (input и output) то есть...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
7
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.