Дедофорум Z
     
powered by simpleCommunicator - 2.0.18     © 2024 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Map
Форумы / Поиск: Искать ответы на сообщение: #365369  
3 сообщений из 3, страница 1 из 1
Просто Трёп / Чат гопоты
    #365369
s62
Скрыть профиль Поместить в игнор-лист
s62
Участник
Просто Трёп [игнорируется] 

Что-то уже несколько дней работать не хочется. Ну тут и пятница еще. Вот, написал программку и напустил ее на список по ссылке. 1615 слов таких нашла.
Вот код, без особых проверок, может и ошибки в нем есть, написал, но особо не анализировал.
Код: Delphi
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.
...
Рейтинг: 0 / 0
21.04.2023, 15:41
| Ответить | Цитировать | Написать | Ответы | Перейти в тему  
Просто Трёп / Чат гопоты
    #365427
Antonariy
Скрыть профиль Поместить в игнор-лист
Antonariy
Участник
s62  21.04.2023, 15:41
[игнорируется]
365369
Просто Трёп [игнорируется] 

Что-то уже несколько дней работать не хочется. Ну тут и пятница еще. Вот, написал программку и напустил ее на список по ссылке. 1615 слов таких нашла.
Вот код, без особых проверок, может и ошибки в нем есть, написал, но особо не анализировал.
Код: Delphi
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.
А это гпт-4, сравни уровень. И базу нашел, и дельфи приспособил. Но интерпретировать не умеет, это в гпт-5 ожидается.
...
Рейтинг: 0 / 0
21.04.2023, 16:00
| Ответить | Цитировать | Написать | Перейти в тему  
Просто Трёп / Чат гопоты
    #369405
Просто Трёп
Скрыть профиль Поместить в игнор-лист
Просто Трёп
Участник
s62  21.04.2023, 15:41
[игнорируется]
365369
Просто Трёп [игнорируется] 

Что-то уже несколько дней работать не хочется. Ну тут и пятница еще. Вот, написал программку и напустил ее на список по ссылке. 1615 слов таких нашла.
Вот код, без особых проверок, может и ошибки в нем есть, написал, но особо не анализировал.
Спойлер
Код: Delphi
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.
Спойлер
База (можно не делать)
Код: 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
Таблица:
Код: 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.
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
процедура:
Код: 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.
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
Сам ввод данных:
Код: 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.
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
Для каждого слова сохраняются данные: длинна слова, количество букв из первой группы, количество букв из второй группы. Ну а потом уже селктики какие хочешь верти. Слов, набираемых преимущественно правой рукой поразительно мало. На порядок меньше, чем тех, которые набираются левой рукой.
...
Рейтинг: 0 / 0
24.04.2023, 15:15
| Ответить | Цитировать | Написать | Перейти в тему  
3 сообщений из 3, страница 1 из 1
Форумы / Поиск: Искать ответы на сообщение: #365369  
Пользователи онлайн (47): Анонимы (45), Yandex Bot 2 мин., Bing Bot 4 мин.
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Польз. соглашение
ReSQL.ru, Чоткий форум, Чат Кролика       Пашэ: Рисунки, Чат       Деда: Фотоальбом, Встречи
Закрыть
Start [/forum/search.php?do_search=1&replies_to=365369&author_mode=wrote_post]:
 0ms
get settings:
 1ms
get forum list:
 5ms
searching:
 10ms
get settings:
 1ms
get forum list:
 4ms
get found posts:
 23ms
track hit:
 34ms
get online users:
 32ms
check new:
 2ms
others: 271ms
total:  383ms
созд. / загр.: 383ms (нв.: 2ms)
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]