Алгоритм Флойда

Полный ориентированный взвешенный граф задан матрицей смежности. Постройте матрицу кратчайших путей между его вершинами. Гарантируется, что в графе нет циклов отрицательного веса.

Входные данные

В первой строке входного файла 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.  

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.

 
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;

• Нахождение суммы на отрезке [L;R]
  
• Нахождение минимума и максимума на отрезке [L;R]
  
• Изменение элементов (увеличение и уменьшение) на отрезке [L;R]

• операция INIT является самой первой операцией во входном файле и больше нигде в нем не встречается;
  
• для операции MODIFY выполняются ограничения 1 ≤ pos ≤ N и -10000 ≤ value ≤ 10000;
  
• для операции FINDSUM выполняются ограничения 1 ≤ l ≤ r ≤ N.

 
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;

 Я. Илья (15 января 2012 - 12:14) писал:

 LVP (15 января 2012 - 16:55) писал:

• Сортируем вершины топологически.
  
• Инвертируем граф (т.е. меняем направления ребер, например если было ребро из 2 в 3 вершину, то делаем из 3 во 2)
  
• Пробегаемся по отсортированному массиву и если находим не помеченную вершину, то увеличиваем счетчик кол-во к.с.с. и пускаем dfs2 от этой вершины

 
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;

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.

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.

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.

Andrew (14 ноября 2012 - 15:42) писал:

Задача Пересечение окружностей


Задан набор из N окружностей, которые описываются координатами своих центров. Все окружности имеют одинаковый радиус R. Необходимо найти две окружности, площадь пересечения которых максимальная. На рисунке красным цветом отображается область пересечения двух окружностей.



Формат ввода:

N R
X[1] Y[1]
X[2] Y[2]
…
X[N] Y[N]

N – Количество окружностей
R – Радиус окружностей
X[i] Y[i] – центр i-ой окружности

Ограничения:

2 <= N < = 100
0 <= X[i] Y[i] R <= 1000
Все числа целые.

Формат вывода:

Ответ на задачу - номера окружностей, площадь пересечения которых максимальная.

Пример ввода:

3 1
0 0
1 0
1 1

Пример вывода:

1 2

Программный код.

var x,y:array[1..1000] of longint; n,i,r,n2,n1,j:longint; minp,p:real;
begin
readln(n,r);
for i:=1 to n do
  readln(x[i],y[i]);
minp:=sqrt( (x[1]-x[2])*(x[1]-x[2])+(y[1]-y[2])*(y[1]-y[2]) );
n1:=1;
n2:=2;
for i:=1 to n do
  for j:=1 to n do
   begin
	p:=sqrt( (x[i]-x[j])*(x[i]-x[j])+(y[i]-y[j])*(y[i]-y[j]) );
	if (minp >p)and(i<>j) then begin
                            	minp:=p;
                            	n1:=i;
                            	n2:=j;
                           	end;
   end;
writeln(n1,' ',n2);
end.

Перестановка из 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.

Перестановка из 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.

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.

var x1,x2,x0,y1,y2,y0,s1,s2,s3,a,b,c,p,h:real;
begin
//1 Вариант. Косое произведение векторов
readln(x1,y1,x2,y2,x0,y0);
s1:=abs((x2-x1)*(y0-y1)-(y2-y1)*(x0-x1))/2;
writeln(s1:0:15);
//2 Вариант. По формуле Герона
a:=sqrt((x1-x0)*(x1-x0)+(y1-y0)*(y1-y0));
  b:=sqrt((x2-x0)*(x2-x0)+(y2-y0)*(y2-y0));
   c:=sqrt((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1));
p:=(a+b+c)/2;
s2:=sqrt(p*(p-a)*(p-B)/>*(p-c));
writeln(s2:0:15);
//3 Вариант. Произведение высоту на сторону, к которой она проведена
h:=abs((y2-y1)*x0+(x1-x2)*y0+(y1*x2-x1*y2))/sqrt(a*a+b*B)/>;
s3:=h*c/2;
writeln(s3:0:15 );
end.

Грядки

Прямоугольный садовый участок шириной 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.

Задача Кратчайший маршрут

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.

function pr(x:longint):boolean;
var d:longint;
begin
if x mod 2 =0 then pr:=(x=2)
          	else
          	begin
  d:=3;
  while (d*d<=x)and(x mod d <>0) do
  d:=d+2;
  pr:=(d*d>x)and(x<>1);
end;
end;

Задача

Вывести все простые числа от M до N включительно.

Ограничения: 2 <= M <= N <= 300 000.

Ввод: В первой строке находятся разделённые пробелом M и N.

Вывод: Вывести числа в порядке возрастания, по одному в строке. Если между M и N включительно нет простых - вывести "Absent".

Примеры

Ввод 1

2 5

Вывод 1

2

3

5

var n,m,i,f:LONGINT;
function pr(x:longint):boolean;
var d:longint;
begin
if x mod 2 =0 then pr:=(x=2)
          	else
          	begin
  d:=3;
  while (d*d<=x)and(x mod d <>0) do
  d:=d+2;
  pr:=(d*d>x)and(x<>1);
end;
end;
begin
f:=0;
readln(n,m);
for i:=n to m do
if pr(i) then begin writeln(i); f:=1; end;
if f=0 then writeln('Absent');
end.

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.

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.

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.

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.