Andrew (14 ноября 2012 - 15:42) писал:
Сделано
37 публикаций создано Санек (учитываются публикации только с 10-мая 23)
Отправлено от Санек в 14 ноября 2012 - 17:29 in Структуры данных
Отправлено от Санек в 23 декабря 2011 - 14:14 in Рекурсия
var a,b :longint; function NOD(x,y:longint):longint; //Функция поиска НОДа двух чисел begin if x<>0 then NOD:=NOD(y mod x,x) else NOD:=y; end; function NOK(x,y:longint):longint; //Функция поиска НОКа двух чисел begin NOK:=( x div NOD(x,y) ) * y; end; begin readln(a, b ); writeln( 'НОД этих чисел = ', NOD(a,b ) ); writeln( 'НОК этих чисел = ', NOK(a,b ) ); end.
Отправлено от Санек в 23 декабря 2011 - 19:18 in Динамическое программирование
var f:array [1..70] of int64; i,n:longint; begin readln(n); //считываем число ступенек f[1]:=1; //если у нас 1 ступенька, то кол-во способов 1, т.к. есть один способ сигануть с вершины лесенки до основания, если всего одна ступенька (проверьте сами) f[2]:=2; //если у нас 2 ступеньки, то кол-во способов 2, т.к. есть два способа сигануть с вершины лесенки до основания, если всего две ступеньки (проверьте сами) f[3]:=4; //если у нас 3 ступеньки, то кол-во способов 4, т.к. есть четыре способа сигануть с вершины лесенки до основания, если всего три ступеньки (проверьте сами) for i:=4 to n do f[i]:=f[i-2]+f[i-1]+f[i-3]; //А дальше динамика. В массив ответов заносим сумму вариантов "сигания" с i-1, i-2, i-3 ступенек. writeln(f[n]); //ответ на задачу end.
Отправлено от Санек в 23 декабря 2011 - 19:10 in Динамическое программирование
var a,f:array [1..10000]of longint; n,i,max,j:longint; begin readln(n); //читаем кол-во чисел for i:=1 to n do read(a[i]); //считываем последовательность for i:=1 to n do f[i]:=1; //забиваем массив ответов 1 for i:=1 to n do for j:=1 to i-1 do if (a[i]>a[j]) and (f[j]+1>f[i]) then f[i]:=f[j]+1; //ищем длину возрастающей последовательности на каждом шаге последовательности for i:=1 to n do if f[i]>max then max:=f[i]; //находим максимальную подпоследовательность в массиве ответов writeln(max); end.
Отправлено от Санек в 20 ноября 2012 - 17:49 in Графы
procedure dfs(v:longint); var i:longint; begin used[v]:=true;//помечаем вершину for i:=1 to n do //перебираем все вершины if not(used[i]) and (g[v,i]=1) then dfs(i); //если вершина не помеченна и есть путь из нашей вершину в нее, то запускаем глубину от этой вершины cnt:=cnt+1;//кол-во вершин тоположке dag[cnt]:=v; //кидаем нашу вершину в топологически отсортированный массив end;
for i:=1 to n do for j:=1 to n do if (g[i,j]=1) then g1[j,i]:=1; //здесь думаю все понятно
scc:=0; for i:=cnt downto 1 do if not(used[dag[i]]) //если вершина не помеченна then begin scc:=scc+1; //на 1 увеличиваем кол-во к.с.с. dfs2(dag[i]); //пускаем dfs2 от нашей вершины end; writeln(scc);
procedure dfs2(v:longint); var i:longint; begin used[v]:=true; //помечаем вершину for i:=1 to n do//перебираем все вершины if not(used[i]) and (g1[v,i]=1) then dfs2(i);//если вершина не помеченна и есть путь из нашей вершину в нее, то запускаем глубину от этой вершины end;
Отправлено от Санек в 24 сентября 2012 - 12:15 in Флудилка
Отправлено от Санек в 14 ноября 2012 - 12:45 in Структуры данных
procedure init; begin readln(n); pr:=1; while pr<n do pr:=pr*2; end;
procedure modify(p,v:longint); begin a[p]:=a[p]+v; if p<>1 then modify(p div 2,v); end;
procedure findsum(v,l,r:longint); begin if (lv>r) or (rv<l) then exit else if (l>=lv) and (rv>=r) then s:=s+a[v] else begin findsum(2*v,l,(l+r)div 2); findsum(2*v+1,(l+r)div 2+1,r); end; end;
читаем b if b=1 then init; if b=2 then begin readln(p,v); p:=pr+p-1; modify(p,v); end; if b=3 then begin readln(lv,rv); lv:=pr+lv-1; rv:=pr+rv-1; findsum(1,pr,2*pr-1); writeln(s); s:=0; end; end;
Отправлено от Санек в 16 ноября 2012 - 16:16 in Структуры данных
procedure shift_up(pos:longint); begin while (pos<>1) and (a[pos div 2] < a[pos]) do //пока не дошли до предка и потомок больше предка begin x:=a[pos div 2]; //меняем их местами a[pos div 2]:=a[pos]; a[pos]:=x; pos:=pos div 2; //теперь мы в предке вершины pos end; end;
procedure shift_up(pos:longint); var x:longint; begin if pos=1 then exit; //если мы в самом вверху, то вылетаем if a[pos div 2] < a[pos] //если потомок больше предка then //то меняем их местами begin x:=a[pos div 2]; a[pos div 2]:=a[pos]; a[pos]:=x; shift_up(pos div 2); //подымаем предка наверх end; end;
procedure shift_down(pos:longint); var pos2,x:longint; begin while (2*pos<=n) do //пока мы не пришли в последний элемент begin pos2:=pos; if (a[2*pos]>a[pos2]) //если левый потомок больше предка then pos2:=2*pos; //номеру предка присваем номер потомка if (2*pos+1<=n) and (a[2*pos+1]>a[pos2]) //если правый потомок есть и он больше предка then pos2:=2*pos+1; //номеру предка присваем номер потомка if (pos=pos2) then break; //если предок это потомок тогда вылетаем x:=a[pos]; //меняем местами предка и потомка a[pos]:=a[pos2]; a[pos2]:=x; pos:=pos2; //номеру потомка присваем номер предка end; end;
procedure shift_down(pos:longint); var pos2:longint; begin pos2:=pos; if pos*2>n then exit; //если пришли в последний элемент то вылетаем if a[pos*2]>a[pos2] //если левый потомок больше предка then pos2:=pos*2; //номеру предка присваем номер потомка if (pos*2+1<=n) and (a[pos*2+1]>a[pos2]) //если правый потомок есть и он больше предка then pos2:=pos*2+1; //номеру предка присваем номер потомка if pos=pos2 then exit; //если предок это потомок тогда вылетаем x:=a[pos]; //меняем местами предка и потомка a[pos]:=a[pos2]; a[pos2]:=x; shift_down(pos2);//топим потомка end;
Отправлено от Санек в 21 декабря 2011 - 17:52 in Сортировка и перебор
var a:array [1..1000000] of longint; i,n:longint; procedure qSort(l,r:longint); var i,j,z,x:longint; begin i:=l; j:=r; x:=a[(i+j)div 2];{находим средний элемент} repeat while a[i]<x do i:=i+1;{ищем слева элемент который >=x } while a[j]>x do j:=j-1;{а справа элемент который <=x } if i<=j then begin z:=a[i]; a[i]:=a[j]; a[j]:=z; i:=i+1; j:=j-1; end; {меняем местами элементы a[i] и a[j] и изменяем индикаторы i и j} until (i>j); if i<r then qSort(i,r); if j>l then qSort(l,j); end; begin readln(n); for i:=1 to n do read(a[i]); qSort(1,n); {задаём границы сортировки} for i:=1 to n do write(a[i],' '); end.
Отправлено от Санек в 21 декабря 2011 - 18:22 in Графы
Алгоритм Флойда
Полный ориентированный взвешенный граф задан матрицей смежности. Постройте матрицу кратчайших путей между его вершинами. Гарантируется, что в графе нет циклов отрицательного веса.
Входные данные
В первой строке входного файла INPUT.TXT записано единственное число N (1 <= N <= 100) - количество вершин графа. В следующих N строках по N чисел - матрица смежности графа (j-ое число в i-ой строке соответствует весу ребра из вершины i в вершину j). Все числа по модулю не превышают 100. На главной диагонали матрицы - всегда нули.
Выходные данные
В выходной файл OUTPUT.TXT выведите N строк по N чисел - матрицу кратчайших расстояний между парами вершин. j-ое число в i-ой строке должно быть равно весу кратчайшего пути из вершины i в вершину j.
Пример
INPUT.TXT
4
0 5 9 100
100 0 2 8
100 100 0 7
4 100 100 0
OUTPUT.TXT
0 5 7 13
12 0 2 8
11 16 0 7
4 9 11 0
var g:array [1..100,1..100] of longint; n,j,i,k:longint; function min(x,y:longint):longint; begin if x<y then min:=x else min:=y; end; begin //Считываем граф readln(n); for i:=1 to n do for j:=1 to n do read(g[i,j]); //Вот это - алгоритм Флойда, т.е простейший для реализации способ нахождения кратчайших расстояний от каждой вершины к каждой for k:=1 to n do for i:=1 to n do for j:=1 to n do G[i,j]:=min(G[i,j],G[i,k]+G[k,j]); //Вывод полученного графа for i:=1 to n do begin for j:=1 to n do write(g[i,j],' '); writeln; end; end.