# Anagram lalala

By: a guest on Apr 21st, 2012  |  syntax: Pascal  |  size: 2.92 KB  |  hits: 37  |  expires: Never
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
1. var
2.   arr1 : array [1..10000] of string;
3.   arr2 : array [1..10000] of string;
4.
5. function kode (s : string) : string;
6. var
7.   a, angka, b : longint;
8.   hasil : string;
9.   arr : array [1..26] of longint;
10. begin
11.   for a := 1 to 26 do arr[a] := 0;
12.   for a := 1 to length (s) do begin
13.     angka := ord(s[a])- 96;
14.     inc (arr[angka]);
15.   end;
16.   hasil:='';
17.   for a:= 1 to 26 do begin
18.     if arr[a]>0 then begin
19.       for b:= 1 to arr[a] do hasil:= hasil + chr(a+96);
20.     end;
21.   end;
22.   kode := hasil;
23. end;
24.
25. procedure qs1 (a, b : longint);
26. var
27.   p, i, j : longint;
28.   pivot, temp : string;
29. begin
30.   if a < b then begin
31.     pivot := arr1[a];
32.     i := a;
33.     j := b;
34.     while i < j do begin
35.       while (arr1[i] <= pivot) and (i < j) do inc (i);
36.       while (arr1[j] > pivot) and (i < j) do dec (j);
37.       if i <= j then begin
38.         temp := arr1[i];
39.         arr1[i] := arr1[j];
40.         arr1[j] := temp;
41.         inc (i);
42.         dec (j);
43.       end;
44.     end;
45.     qs1 (a, j);
46.     qs1 (i, b);
47.   end;
48. end;
49.
50. procedure qs2 (a, b : longint);
51. var
52.   p, i, j : longint;
53.   pivot, temp1, temp2 : string;
54. begin
55.   if a < b then begin
56.     pivot := arr2[a];
57.     i := a;
58.     j := b;
59.     while i < j do begin
60.       while (arr2[i] <= pivot) and (i < j) do inc (i);
61.       while (arr2[j] > pivot) and (i < j) do dec (j);
62.       if i <= j then begin
63.         temp2 := arr2[i];
64.         arr2[i] := arr2[j];
65.         arr2[j] := temp2;
66.         temp1 := arr1[i];
67.         arr1[i] := arr1[j];
68.         arr1[j] := temp1;
69.         inc (i);
70.         dec (j);
71.       end;
72.     end;
73.     qs2 (a,j);
74.     qs2 (i, b);
75.   end;
76. end;
77.
78. var
79.   n, a, b, max, jum, c : longint;
80.   skode, kata, s, maxkata, maxkode : string;
81. begin
83.   arr1[n+1] := 'zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz';
84.   arr2[n+1] := 'zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz';
85.   for a := 1 to n do begin
87.     arr1[a] := s;
88.     arr2[a] := kode(s);
89.   end;
90.   qs2 (1, n);
91.   a := 1;
92.   jum := 1;
93.   max := 0;
94.   maxkata := '';
95.   maxkode := '';
96.   skode := arr2[1];
97.   kata := arr1[1];
98.   while a <= n do begin
99.     if arr2[a] = arr2[a+1] then begin
100.       inc (jum);
101.       if arr1[a] < kata then kata := arr1[a];
102.       inc (a);
103.     end else begin
104.       if jum > max then begin
105.         max := jum;
106.         maxkode := skode;
107.         maxkata := kata;
108.       end else if (jum = max) and (kata < maxkata) then begin
109.         maxkode := skode;
110.         maxkata := kata;
111.       end;
112.       jum := 1;
113.       skode := arr2[a+1];
114.       kata := arr1[a+1];
115.       inc (a);
116.     end;
117.   end;
118.   if max > 1 then begin
119.     writeln (max);
120.     a := 1;
121.     while arr2[a] <> maxkode do inc (a);
122.     b := n;
123.     while arr2[b] <> maxkode do dec (b);
124.     qs1 (a, b);
125.     for c := a to b do
126.       writeln (arr1[c]);
127.   end else writeln ('TIDAK ADA');
128. end.