Я. Илья (15 января 2012 - 12:14) писал:
Они были зарегистрированы, потом удалены за спам
37 публикаций создано Санек (учитываются публикации только с 12-мая 23)
Отправлено от Санек в 14 ноября 2012 - 17:29 in Структуры данных
Отправлено от Санек в 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.
Отправлено от Санек в 22 декабря 2011 - 08:27 in Комбинаторика
type mas= array [0..1000] of byte; var p,q:mas; n,m,i,j,s,k,d:longint; b:array [1..1000] of char; begin readln(n,m); for i:=1 to n do read(b[i]); s:=0; for i:=0 to m do p[i]:=i; //Часть 1 REPEAT //Часть 2 for i:=0 to m do q[i]:=p[i]; while q[0]=0 do Begin while q[0]=0 do begin for i:=1 to m do write(b[q[i]]); writeln; inc(s); j:=m; while q[j-1]>q[j] do dec(j); k:=m; while q[j-1]>q[k] do dec(k); d:=q[j-1]; q[j-1]:=q[k]; q[k]:=d; for i:=j to (m+j-1)div 2 do begin d:=q[m+j-i]; q[m+j-i]:=q[i]; q[i]:=d; end; end; end; //Часть 3 j:=m; while (j>0) and(p[j]=j+n-m) do dec(j); if j>0 then begin p[j]:=p[j]+1; for i:=j+1 to m do p[i]:=p[i-1]+1; end; UNTIL j=0; writeln(s); end.
type mas= array [0..1000] of byte; var p:mas; n,m,i,j,s:longint; b:array [1..1000] of char; procedure perestan(q:mas); var i,j,k,d:longint; begin while q[0]=0 do begin for i:=1 to m do write(b[q[i]],' '); writeln; inc(s); j:=m; while q[j-1]>q[j] do dec(j); k:=m; while q[j-1]>q[k] do dec(k); d:=q[j-1]; q[j-1]:=q[k]; q[k]:=d; for i:=j to (m+j-1)div 2 do begin d:=q[m+j-i]; q[m+j-i]:=q[i]; q[i]:=d; end; end; end; begin readln(n,m); for i:=1 to n do read(b[i]); for i:=0 to m do p[i]:=i; REPEAT perestan(p); j:=m; while (j>0) and(p[j]=j+n-m) do dec(j); if j>0 then begin p[j]:=p[j]+1; for i:=j+1 to m do p[i]:=p[i-1]+1; end; until j=0; writeln(s); end.
Отправлено от Санек в 25 декабря 2011 - 18:56 in Строки
Типы данных char и string
char - символьный тип
string - строковый тип
Символьный тип
Значением переменных символьного типа char является один символ. Каждому символу соответствует код символа - целое число в диапазоне от 0 до 255. Значит, символьный тип является порядковым. В таких языках программирования как C, Java тип char относят к целым типам, что разумно, т.к. в памяти компьютера нет символов - есть только их числовые коды. Значит, все действия по обработке символов сводятся к действиям над целыми числами, расположенными строго по порядку.
Над данными символьного типа определены операции отношения: =, <>, <, >, <=, >=.
Для данных символьного типа определены стандартные функции:
var s:string; i:longint; begin readln(s); for i:=length(s) downto 1 do write(s[i]); writeln; for i:=1 to length(s) do if (s[i]=' ') and (s[i+1]<>' ') then writeln else write(s[i]); 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 - 18:18 in Графы
Грядки
Прямоугольный садовый участок шириной N и длиной M метров разбит на квадраты со стороной 1 метр. На этом участке вскопаны грядки. Грядкой называется совокупность квадратов, удовлетворяющая таким условиям:
из любого квадрата этой грядки можно попасть в любой другой квадрат этой же грядки, последовательно переходя по грядке из квадрата в квадрат через их общую сторону;
никакие две грядки не пересекаются и не касаются друг друга ни по вертикальной, ни по горизонтальной сторонам квадратов (касание грядок углами квадратов допускается).
Подсчитайте количество грядок на садовом участке.
Входные данные
В первой строке входного файла INPUT.TXT находятся числа N и M через пробел, далее идут N строк по M символов. Символ # обозначает территорию грядки, точка соответствует незанятой территории. Других символов в исходном файле нет. (1 <= N, M <= 200)
Выходные данные
В выходной файл OUTPUT.TXT выведите количество грядок на садовом участке.
Примеры
INPUT.TXT
5 10
##......#.
.#..#...#.
.###....#.
..##....#.
........#.
OUTPUT.TXT
3
Основной код
var g:array [1..200,1..200] of char; k,i,j,n,m:integer; procedure dfs(x,y:longint); begin g[x,y]:='o'; if (y<m )and(g[x,y+1]='#') then dfs(x,y+1); if (y>1 )and(g[x,y-1]='#') then dfs(x,y-1); if (x<n )and(g[x+1,y]='#') then dfs(x+1,y); if (x>1 )and(g[x-1,y]='#') then dfs(x-1,y); end; begin readln(n,m); k:=0; for i:=1 to n do begin for j:=1 to m do read(g[i,j]); readln; end; for i:=1 to n do for j:=1 to m do begin if (g[i,j]='#') then begin k:=k+1; dfs(i,j); end; end; writeln(k); end.
Отправлено от Санек в 24 сентября 2012 - 12:15 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.
Отправлено от Санек в 17 января 2012 - 18:53 in Комбинаторика
Отправлено от Санек в 22 декабря 2011 - 10:24 in Одномерные массивы
var a:array [1..1000] of longint; n,i,s:longint; begin readln(n); //ввод n - числа элементов в массиве for i:=1 to n do //ввод чисел массива read(a[i]); for i:=1 to n do //подсчет суммы всех элементов s:=s+a[i]; writeln(s); //вывод суммы end.
Отправлено от Санек в 21 декабря 2011 - 18:08 in Комбинаторика
Перестановка из n элементов - это соединения из n различных элементов, взятых в определенном порядке.
var b:string; p:array [0..255] of integer; c,n,i,j,r,q,d,k:longint; begin readln(B)/>; n:=length(B)/>; for i:=0 to n do p[i]:=i; while p[0]=0 do Begin for i:=1 to n do write(b[p[i]]); writeln; j:=n; while p[j-1]>p[j] do j:=j-1; k:=n; while p[j-1]>p[k] do k:=k-1; d:=p[k]; p[k]:=p[j-1]; p[j-1]:=d; for i:=j to (n+j-1)div 2 do begin d:=p[i]; p[i]:=p[n-i+j]; p[n-i+j]:=d; end; end; end.
Отправлено от Санек в 19 ноября 2012 - 18:27 in Графы
for i:=1 to n do if not(used[i]) then dfs(i);
procedure dfs(v:longint); var i:longint; begin used[v]:=false; //помечаем вершину, типа мы здесь были for i:=1 to n do if (not(used[i])) and (g[v,i]=1) //если мы не были в этой вершине и есть путь из вершины v в нашу then begin parent[i]:=v; //предком для нашей вершины является вершина v, т.е. мы пришли из неё dfs(i); //глубиной идем от нашей вершины end; inc(cnt); //увеличиваем счетчик dag[cnt]:=v; //в массив тоположки кидаем нашу вершину v end;
for i:=cnt downto 1 do write(dag[i],' ');
Отправлено от Санек в 15 ноября 2012 - 15:17 in Целочисленная арифметика
Число называется совершенным, если оно равно сумме всех своих делителей, меньших его самого. Требуется найти все совершенные числа от n до m (1 <= n,m <=100000)
Ввод
Два числа n и m
Вывод
В каждой строке вывести совершенные числа на промежутке от n до m. Если таких нет, вывести Absent.
Пример
______
6 6
6
______
4 5
Absent
______
Решение
Циклом бежим от n до m и находим сумму делителей числа i. Если сумма равна i, тогда выводим число i.
var n,m,i:int64; f:boolean; function pr(x:int64):boolean; var d,s:int64; begin s:=1; if(x=1)then begin pr:=false; exit; end; d:=2; while int64(d)*d<x do begin if(x mod d=0)then s:=s+d+(x div d); d:=d+1; end; if d*d=x then s:=s+d; pr:=(s=x); //if s=x then pr:=true else pr:=false; end; begin assign(input,'input.txt'); reset(input); assign(output,'output.txt'); rewrite(output); readln(n,m); f:=false; for i:=n to m do if(pr(i))then begin writeln(i); f:=true; end; if not(f) then writeln('Absent'); end.
Отправлено от Санек в 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;
Отправлено от Санек в 22 декабря 2011 - 12:40 in Комбинаторика
var p: array [0..1000] of byte; n,m,i,j,s:longint; b:array [1..1000] of char; begin readln(n,m); for i:=1 to n do read(b[i]); for i:=0 to m do p[i]:=i; REPEAT for i:=1 to m do write(b[p[i]]); writeln; s:=s+1; j:=m; while (j>0) and(p[j]=j+n-m) do dec(j); if j>0 then begin p[j]:=p[j]+1; for i:=j+1 to m do p[i]:=p[i-1]+1; end; UNTIL j=0; writeln(s); end.
Отправлено от Санек в 22 декабря 2011 - 10:15 in Двумерные массивы
var a:array[1..100,1..100] of longint; s,n,m,i,j:longint; begin readln(n,m); s:=0; for i:=1 to n do for j:=1 to m do read(a[i,j]); for i:=1 to n do for j:=1 to m do s:=s+a[i,j]; writeln(s); end.
Отправлено от Санек в 21 декабря 2011 - 18:11 in Графы
Задача Кратчайший маршрут
var g:array[1..1000,1..1000] of longint; p,q:array [1..1000] of longint; i,uk,un,n,m,a,b,v:longint; begin readln(n,m); for i:=1 to m do begin readln(a,B)/>; g[a,b]:=g[a,b]+1; g[b,a]:=g[b,a]+1; end; for i:=1 to n do begin p[i]:=-1; g[i,i]:=0; end; un:=1; uk:=2; p[1]:=0; q[1]:=1; while uk<>un do begin v:=q[un]; un:=un+1; for i:=1 to n do if (g[v,i]>0)and(p[i]=-1) then begin q[uk]:=i; uk:=uk+1; p[i]:=p[v]+1; end; end; writeln(p[n]); end.
Отправлено от Санек в 21 декабря 2011 - 18:02 in Геометрия
Задача №1
Вводятся a,b,c. Найти угол наклона прямой к оси Ox.
Думаю вы знаете что число pi(дальше буду обозначать его так как в паскале) это 180 градусов. Т.е. 3,14 = 180 градусам. Тогда угол наклона прямой к оси Ox можно найти по формуле (угол наклона прямой к оси Ox обозначим u):
u=arctg(-a/ b *180(градусов)/pi
var a,b,u:real; begin readln(a,B)/>; if b=0 then u:=90 else u=arctg(-a/B)/>*180/pi; writeln(u); end.
Отправлено от Санек в 22 декабря 2011 - 10:50 in Одномерные массивы
var a:array[1..1000] of integer; i,j,n:integer; begin readln(n); //ввод количества элементов for i:=1 to n do //ввод элементов массива read(a[i]); i:=1; while (i<10) and (j<n+1) do //подсчет количества различных элементов begin j:=i+1; while (j<n+1) and (a[i]<>a[j]) do j:=j+1; i:=i+1; end; if i<11 then writeln('В массиве ',i,' одинаковых элементов') else writeln('Все элементы массива различны'); end.
Отправлено от Санек в 22 декабря 2011 - 12:35 in Комбинаторика
Перестановка из n элементов - это соединения из n различных элементов, взятых в определенном порядке.
var b:string; p:array [0..255] of integer; c,n,i,j,r,q,d,k:longint; begin readln(B)/>; n:=length(B)/>; for i:=0 to n do p[i]:=i; while p[0]=0 do Begin for i:=1 to n do write(b[p[i]]); writeln; j:=n; while p[j-1]>p[j] do j:=j-1; k:=n; while p[j-1]>p[k] do k:=k-1; d:=p[k]; p[k]:=p[j-1]; p[j-1]:=d; for i:=j to (n+j-1)div 2 do begin d:=p[i]; p[i]:=p[n-i+j]; p[n-i+j]:=d; end; end; end.
Отправлено от Санек в 22 декабря 2011 - 12:38 in Комбинаторика
type mas= array [0..1000] of byte; var p,q:mas; n,m,i,j,s,k,d:longint; b:array [1..1000] of char; begin readln(n,m); for i:=1 to n do read(b[i]); s:=0; for i:=0 to m do p[i]:=i; //Часть 1 REPEAT //Часть 2 for i:=0 to m do q[i]:=p[i]; while q[0]=0 do Begin while q[0]=0 do begin for i:=1 to m do write(b[q[i]]); writeln; inc(s); j:=m; while q[j-1]>q[j] do dec(j); k:=m; while q[j-1]>q[k] do dec(k); d:=q[j-1]; q[j-1]:=q[k]; q[k]:=d; for i:=j to (m+j-1)div 2 do begin d:=q[m+j-i]; q[m+j-i]:=q[i]; q[i]:=d; end; end; end; //Часть 3 j:=m; while (j>0) and(p[j]=j+n-m) do dec(j); if j>0 then begin p[j]:=p[j]+1; for i:=j+1 to m do p[i]:=p[i-1]+1; end; UNTIL j=0; writeln(s); end.
type mas= array [0..1000] of byte; var p:mas; n,m,i,j,s:longint; b:array [1..1000] of char; procedure perestan(q:mas); var i,j,k,d:longint; begin while q[0]=0 do begin for i:=1 to m do write(b[q[i]],' '); writeln; inc(s); j:=m; while q[j-1]>q[j] do dec(j); k:=m; while q[j-1]>q[k] do dec(k); d:=q[j-1]; q[j-1]:=q[k]; q[k]:=d; for i:=j to (m+j-1)div 2 do begin d:=q[m+j-i]; q[m+j-i]:=q[i]; q[i]:=d; end; end; end; begin readln(n,m); for i:=1 to n do read(b[i]); for i:=0 to m do p[i]:=i; REPEAT perestan(p); j:=m; while (j>0) and(p[j]=j+n-m) do dec(j); if j>0 then begin p[j]:=p[j]+1; for i:=j+1 to m do p[i]:=p[i-1]+1; end; until j=0; writeln(s); end.
Отправлено от Санек в 22 декабря 2011 - 12:37 in Комбинаторика
var b:string; p,kp:array [0..255] of integer; n,i,j,d,k,l,s:longint; begin readln(B)/>; n:=length(B)/>; for i:=1 to n do read(kp[i]); p[0]:=0; for i:=1 to n do for j:=1 to kp[i] do begin l:=l+1; p[l]:=i; end; n:=l; while p[0]=0 do Begin for i:=1 to n do write(b[p[i]]); writeln; s:=s+1; j:=n; while p[j-1]>=p[j] do j:=j-1; k:=n; while p[j-1]>=p[k] do k:=k-1; d:=p[k]; p[k]:=p[j-1]; p[j-1]:=d; for i:=j to (n+j-1)div 2 do begin d:=p[i]; p[i]:=p[n-i+j]; p[n-i+j]:=d; end; end; writeln(s); end.
Отправлено от Санек в 22 декабря 2011 - 12:41 in Комбинаторика
var p:array [0..1000] of integer; b:array [0..1000] of char; i,j,m,n,s:longint; begin readln(n,m); for i:=0 to n-1 do read(b[i]); for i:=0 to m do p[i]:=0; while p[0]=0 do begin j:=m; while p[j]=n-1 do begin p[j]:=0; j:=j-1; end; p[j]:=p[j]+1; for i:=1 to m do write(b[p[i]]); s:=s+1; writeln; end; writeln(s); end.