|
24.04.2023, 15:15
#369405
Ссылка:
Ссылка на сообщение:
Ссылка с названием темы:
Ссылка на профиль пользователя:
|
|
|
Участник
Сообщения: 16 919
Рейтинг:
4318
/ 28
|
|
|
|
Просто Трёп [игнорируется]
Что-то уже несколько дней работать не хочется. Ну тут и пятница еще. Вот, написал программку и напустил ее на список по ссылке. 1615 слов таких нашла.
Вот код, без особых проверок, может и ошибки в нем есть, написал, но особо не анализировал.
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.
unit MainFrm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Memo: TMemo;
Button1: TButton;
Button2: TButton;
dlgOpen: TOpenDialog;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
function CheckWord(const aWord: string): boolean;
function CheckLetter(aLetter: Char): boolean;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//q, w, e, r, t, a, s, d, f, g, z, x, c, v, b
const
WrongLetters: array[0..10] of Char = 'hijklmnopuy';
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var List: TStringList;
i, f: Integer;
begin
if dlgOpen.Execute() then
begin
List := TStringList.Create;
f := 0;
try
Memo.Lines.BeginUpdate;
Memo.Clear;
try
List.LoadFromFile(dlgOpen.FileName);
for i := 0 to List.Count - 1 do
if CheckWord(List[i]) then
Memo.Lines.Add(List[i])
else inc(f);
Caption := IntToStr(Memo.Lines.Count) + ' слов, отброшено ' + IntToStr(f);
finally
Memo.lines.EndUpdate;
end;
finally
List.Free;
end;
end;
end;
function TForm1.CheckLetter(aLetter: Char): boolean;
var
i: Integer;
begin
Result := True;
for i := Low(WrongLetters) to High(WrongLetters) do
if aLetter = WrongLetters[i] then
begin
Result := False;
Break;
end;
end;
function TForm1.CheckWord(const aWord: string): boolean;
var
i: Integer;
begin
Result := True;
for i := 1 to Length(aWord) do
if not CheckLetter(aWord[i]) then
begin
Result := False;
Break;
end;
end;
end.
Тоже самое для MS SQL.
База (можно не делать) 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.
CREATE DATABASE [words] ON PRIMARY
( NAME = N'words', FILENAME = N'D:\MSSQLData\words.mdf' , SIZE = 3072KB , FILEGROWTH = 1024KB )
LOG ON
( NAME = N'words_log', FILENAME = N'D:\MSSQLData\words_log.ldf' , SIZE = 1024KB , FILEGROWTH = 10%)
GO
ALTER DATABASE [words] SET COMPATIBILITY_LEVEL = 100
GO
ALTER DATABASE [words] SET ANSI_NULL_DEFAULT OFF
GO
ALTER DATABASE [words] SET ANSI_NULLS OFF
GO
ALTER DATABASE [words] SET ANSI_PADDING OFF
GO
ALTER DATABASE [words] SET ANSI_WARNINGS OFF
GO
ALTER DATABASE [words] SET ARITHABORT OFF
GO
ALTER DATABASE [words] SET AUTO_CLOSE OFF
GO
ALTER DATABASE [words] SET AUTO_SHRINK OFF
GO
ALTER DATABASE [words] SET AUTO_CREATE_STATISTICS ON
GO
ALTER DATABASE [words] SET AUTO_UPDATE_STATISTICS ON
GO
ALTER DATABASE [words] SET CURSOR_CLOSE_ON_COMMIT OFF
GO
ALTER DATABASE [words] SET CURSOR_DEFAULT GLOBAL
GO
ALTER DATABASE [words] SET CONCAT_NULL_YIELDS_NULL OFF
GO
ALTER DATABASE [words] SET NUMERIC_ROUNDABORT OFF
GO
ALTER DATABASE [words] SET QUOTED_IDENTIFIER OFF
GO
ALTER DATABASE [words] SET RECURSIVE_TRIGGERS OFF
GO
ALTER DATABASE [words] SET DISABLE_BROKER
GO
ALTER DATABASE [words] SET AUTO_UPDATE_STATISTICS_ASYNC OFF
GO
ALTER DATABASE [words] SET DATE_CORRELATION_OPTIMIZATION OFF
GO
ALTER DATABASE [words] SET PARAMETERIZATION SIMPLE
GO
ALTER DATABASE [words] SET READ_COMMITTED_SNAPSHOT OFF
GO
ALTER DATABASE [words] SET READ_WRITE
GO
ALTER DATABASE [words] SET RECOVERY SIMPLE
GO
ALTER DATABASE [words] SET MULTI_USER
GO
ALTER DATABASE [words] SET PAGE_VERIFY CHECKSUM
GO
USE [words]
GO
IF NOT EXISTS (SELECT name FROM sys.filegroups WHERE is_default=1 AND name = N'PRIMARY') ALTER DATABASE [words] MODIFY FILEGROUP [PRIMARY] DEFAULT
GO
Таблица: 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.
BEGIN TRANSACTION
SET QUOTED_IDENTIFIER ON
SET ARITHABORT ON
SET NUMERIC_ROUNDABORT OFF
SET CONCAT_NULL_YIELDS_NULL ON
SET ANSI_NULLS ON
SET ANSI_PADDING ON
SET ANSI_WARNINGS ON
COMMIT
BEGIN TRANSACTION
GO
CREATE TABLE dbo.wrds
(
wrd nvarchar(50) NOT NULL,
cnt smallint NOT NULL,
lgr smallint NOT NULL,
rgr smallint NOT NULL
) ON [PRIMARY]
GO
ALTER TABLE dbo.wrds SET (LOCK_ESCALATION = TABLE)
GO
ALTER TABLE dbo.wrds ADD CONSTRAINT
PK_wrds PRIMARY KEY CLUSTERED
(
wrd
) WITH( STATISTICS_NORECOMPUTE = OFF, IGNORE_DUP_KEY = OFF, ALLOW_ROW_LOCKS = ON, ALLOW_PAGE_LOCKS = ON) ON [PRIMARY]
GO
COMMIT
процедура: 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.
create procedure calc_word
@iw nvarchar(50), -- input word
@icnt smallint out, --chars count
@lc smallint out, --chars from left group
@rc smallint out -- chars from right group
as begin
declare @leftgroup nvarchar(50)
declare @rightgroup nvarchar(50)
declare @lcnt smallint, @rcnt smallint --constants
select @leftgroup = 'qwertasdfgzxcvb', @rightgroup = 'yuiophjklnm'
select @lcnt = 15, @rcnt = 11 --constants
select @icnt = len(@iw)
declare @i smallint, @j smallint --counters
declare @c nvarchar(1) -- current char
select @i = 1
set @lc = 0
set @rc = 0
while @i <= @icnt begin
set @c = substring(@iw, @i, 1)
set @i = @i + 1
set @j = 1
while @j <= @lcnt begin
if @c = substring(@leftgroup, @j, 1) set @lc = @lc + 1
set @j = @j + 1
end
set @j = 1
while @j <= @rcnt begin
if @c = substring(@rightgroup, @j, 1) set @rc = @rc + 1
set @j = @j + 1
end
end
end
Сам ввод данных: 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.
declare @inp nvarchar(max) -- all input words
-- по 10-15 тысяч слов за раз нормально заходит. Если сразу 50000 закинуть, может быть очень долго.
select @inp = 'recovery
recreate
recreated
recreates
recreating
recreation
....
zoos
zulu
zulus'
declare @x xml
set @x = '<t>' + replace(@inp, char(13) + char(10), '</t><t>') + '</t>'
declare @sw nvarchar(50) --singe word
declare @c smallint -- char count in signle word
declare @l smallint -- chars from left group
declare @r smallint -- chars from right group
declare cr cursor for
select P.N.value('.', 'nvarchar(50)') from @x.nodes('/t') P(N)
open cr
fetch next from cr into @sw
while @@fetch_status = 0 begin
exec calc_word @sw, @c out, @l out, @r out
insert into wrds (wrd, cnt, lgr, rgr) values (@sw, @c, @l, @r)
fetch next from cr into @sw
end
close cr
deallocate cr
Для каждого слова сохраняются данные: длинна слова, количество букв из первой группы, количество букв из второй группы. Ну а потом уже селктики какие хочешь верти. Слов, набираемых преимущественно правой рукой поразительно мало. На порядок меньше, чем тех, которые набираются левой рукой. |
|
|
