DELPHI盒子
!实时搜索: 盒子论坛 | 注册用户 | 修改信息 | 退出
检举帖 | 全文检索 | 关闭广告 | 捐赠
技术论坛
 用户名
 密  码
自动登陆(30天有效)
忘了密码
≡技术区≡ ①
DELPHI技术
移动应用开发
Web应用开发
数据库专区
报表专区
网络通讯
开源项目
论坛精华贴
≡发布区≡ ②
发布代码
发布控件
文档资料
经典工具
≡事务区≡ ③
网站意见
盒子之家
招聘应聘
信息交换
论坛信息
最新加入： vickyhwb1
今日帖子： 0
在线用户： 7
导航： 论坛 -> DELPHI技术 斑竹:liumazi,sephil  
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/2/24 1:15:49
标题：
新手好奇fmx里程序效率优化问题探讨 浏览:5549
加入我的收藏
楼主： 同样一个功能别人N年前的delphi作品效率真是高,几毫秒就完成了
而本人用delphi11.2的FMX写的需要将近100毫秒
感觉算法已经没法再优化了,指针啥的都试过了,难道别人是用了汇编或是新版delphi编译器退步了,想不明白.
除算法高效外有其他办法提高程序的性能吗 比如编译设置 借助外部工具等.
----------------------------------------------
-
作者：
男 pcplayer (pcplayer) ★☆☆☆☆ -
普通会员
2023/2/24 11:20:51
1楼： 你不说什么功能，以及如何实现，运行在哪个 OS 底下，怎么知道你的问题在哪里？
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/2/24 13:46:32
2楼： @pcplayer 是这样,小弟想试试搞双色球,FMX程序电脑win10系统i7-4790k处理器 
从01到33个号码选6个出来耗时将近79毫秒,别人的只需要3毫秒,欲哭无泪.求高手指点,本人代码如下:

function 返回组合数(m, n: integer): integer;
var
  id: integer;
begin
  id := 1;
  for var i := m downto (m - n + 1) do
    id := id * i;

  for var i := n downto 1 do
    id := round(id / i);
  result := id;
end;
function 组合(var s: array of string; const n: integer): tarray<tarray<string>>;
var
  l: array of integer;
  id, ie, i, j, lh: integer;
  max: array of Integer;
  xs: tarray<TArray<string>>; 
begin
  id := 返回组合数(length(s), n);
  lh := n - 1;

  SetLength(xs, id, n);

  setlength(l, n);
  id := 0;
  SetLength(max, n);
  id := 0;
  for i := (high(s) - n + 1) to high(s) do
  begin
    max[id] := i;
    inc(id);
  end;

  id := 0;
  for i := 0 to n - 1 do
    l[i] := i;
  while true do
  begin 

    for i := 0 to (n - 1) do
    begin 
      xs[id][i] := s[l[i]];
    end;
 

    Inc(id);
    if l[0] = max[0] then
      break;

    for i := lh downto 0 do
    begin
      if l[i] <> max[i] then
      begin
        inc(l[i]);
        if i < lh then
        begin
          ie := l[i]; 
          for j := i + 1 to lh do
          begin
          inc(ie);
          l[j] := ie; 
          end;
        end;
        break;
      end;
    end;
  end;
  result := xs;
  xs := nil;
  l := nil;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  红球基本号码: array[0..32] of string;
  红球全集: tarray<tarray<string>>;
  st: tstopwatch;
begin
  st := tstopwatch.create;
  st.Reset;
  st.Start;
  for var i := 0 to High(红球基本号码) do
    红球基本号码[i] := Format('%.2d', [i + 1]);
  红球全集 := 组合(红球基本号码, 6);
  st.stop;
  showmessage('耗时' + st.ElapsedMilliseconds.tostring + '共' + length(红球全集).tostring);
end;
此帖子包含附件:
JPEG 图像
大小:3,033B
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/2/24 13:48:35
3楼： 别人的
此帖子包含附件:
JPEG 图像
大小:12.9K
----------------------------------------------
-
作者：
男 wr960204 (武稀松) ★☆☆☆☆ -
盒子活跃会员
2023/2/24 15:26:39
4楼： 跟汇编不汇编关系不大，应该是算法问题
----------------------------------------------
武稀松http://www.raysoftware.cn
作者：
男 hs_kill (lzl_17948876) ★☆☆☆☆ -
普通会员
2023/2/24 15:35:45
5楼： 吧所有的string改成integer
红球基本号码[i] := Format('%.2d', [i + 1]);
改成
红球基本号码[i] := i + 1;

速度快一倍 耗时40ms+
----------------------------------------------
http://www.cnblogs.com/lzl_17948876/
作者：
男 hs_kill (lzl_17948876) ★☆☆☆☆ -
普通会员
2023/2/24 15:37:18
6楼： 剩下的应该是算法问题, 如果有3ms的源码到是可以拿来研究下
----------------------------------------------
http://www.cnblogs.com/lzl_17948876/
作者：
男 pcplayer (pcplayer) ★☆☆☆☆ -
普通会员
2023/2/24 15:45:51
7楼： 你的代码，把所有号码拿出来搞循环。

3ms 的，不太可能是搞大循环。我怀疑就是搞了几个随机数完事。

你自己看看你的大循环跑了多数次？你在你的代码里面，加上计数看看。
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/2/24 18:07:04
8楼： @ wr960204 也有可能,请问算法上可否有建议,用啥数据库引擎会不会快点,难道他使用了内存管理插件比如fastmm啥的,总不会加了个aspack的壳就变快了吧.我也不懂.
@hs_kill 所有的string改成integer---确实快了只要47ms,为啥integer的更快呢,但是这个办法治标不治本,毕竟还得显示字符串出来又得花时间,别人加上显示出来的时间才3ms.
@ pcplayer 别人的确实一眨眼就出来了,筛选号码也比我快不少,这个跟随机数应该没关系,随机结果就不正确了.大循环while就是1107568次,因为提前给结果数组分配了这么大的长度.
----------------------------------------------
-
作者：
男 hs_kill (lzl_17948876) ★☆☆☆☆ -
普通会员
2023/2/25 12:14:07
9楼： 本来值就是integer, string的处理速度当然比不上数值
更别说那么大数量

显示也是有方法的, 别说只有11W个结果, 就算11W亿你也只能看见屏幕上的那几个, 所以只显示只需要处理看到的内容就行了
----------------------------------------------
http://www.cnblogs.com/lzl_17948876/
作者：
男 roadrunner (roadrunner) ★☆☆☆☆ -
盒子活跃会员
2023/2/25 18:43:09
10楼： 这种算法，0ms才是正常的。
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/2/25 20:50:18
11楼： @hs_kill 这个确实只需显示屏幕那几个,问题是我还没显示速度就比别人显示出来都慢了.
@roadrunner 求大侠指点一下
----------------------------------------------
-
作者：
男 roadrunner (roadrunner) ★☆☆☆☆ -
盒子活跃会员
2023/2/25 21:03:25
12楼： 用33*32*31*30*29*28/720就可以求出所有的组合数量，结果就是1107568，这就是个常量，编译的时候编译器就自动帮你求出来了，根本就不用算

至于每个组合的具体数值，也根本就不用数组存储，写一个函数，你就传入一个1..1107568之间的参数，让它帮你反推出这个顺序的组合是哪几个数字就可以
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/2/25 21:25:20
13楼： @roadrunner 我试过计算组合数量这个只需要0毫秒,这里不是关键,关键在于组合的过程耗时.
传入一个1..1107568之间的参数,推出这个顺序的组合是哪几个数字----不先全部组合出来直接根据序号就得出第几注应该是什么号码,这个实现就难了,有思路么.
----------------------------------------------
-
作者：
男 roadrunner (roadrunner) ★☆☆☆☆ -
盒子活跃会员
2023/2/25 21:53:44
14楼： 大致的算法如下, 电脑没装delphi, 记事本写的，不一定对，你自己调试一下
//定义一个全局变量查表用
var tabledata : array[0..28,1..6] of integer;

//初始化这个查询表
procedure inittable;
var i,j:integer;
begin
  for i := 1 to 28 do tabledata[i,6] := i;
  for i := 5 downto 1 do for j := 1 to 28 do tabledata[j,i]:=tabledata[j-1,i]+tabledata[j,i+1];
end;

type TData = array[1..6] of integer;
//输入一个序号，返回TDATA表示的6个数值
function GetData(n:integer):TData;
var i,j : integer;
begin
  for i := 1 to 6 do begin
    j := 1;
    while n> tabledata[j,i] do begin
      dec(n,tabledata[j,i])
      inc(j);
    end;
    Result[i] := 28+i-j;
  end;
end;
----------------------------------------------
-
作者：
男 roadrunner (roadrunner) ★☆☆☆☆ -
盒子活跃会员
2023/2/25 22:02:36
15楼： 上面的代码的数字组合排序是从大到小排的，也就是第一个组合就是28到33

如果你想第一个是1到6，把传进去的序号反一下就可以了（用总数减去序号，得到反向序号）
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/2/25 22:41:54
16楼： @roadrunner 是这样用吗,我这里报错,说GetData这里太多实参.
procedure TForm1.Button38Click(Sender: TObject);
var
  dt: TData;
begin
inittable;
dt:= GetData(100);
end;
----------------------------------------------
-
作者：
男 qq81709989 (ChatGPT-4) ▲▲△△△ -
普通会员
2023/2/25 22:44:43
16楼： 建议楼主可以尝试使用多线程并行计算，以充分利用计算机的多核心处理能力。可以将不同的组合计算任务分配到不同的线程中执行，以加快计算速度。

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  System.Diagnostics, FMX.Controls.Presentation, FMX.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

function 返回组合数(m, n: integer): integer;
var
  id: integer;
begin
  id := 1;
  for var i := m downto (m - n + 1) do
    id := id * i;

  for var i := n downto 1 do
    id := Round(id / i);

  Result := id;
end;

function 组合(var s: array of string; const n: integer): TArray<TArray<string>>;
var
  l: array of integer;
  id, i, j: integer;
  xs: TArray<TArray<string>>;
  maxMask, mask, bit: integer;
begin
  id := 返回组合数(length(s), n);

  SetLength(xs, id, n);

  SetLength(l, n);

  maxMask := (1 shl Length(s)) - 1;
  id := 0;
  mask := 0;
  while mask <= maxMask do
  begin
    j := 0;
    bit := 1;
    for i := 0 to Length(s) - 1 do
    begin
      if (mask and bit) <> 0 then
      begin
        xs[id][j] := s[i];
        Inc(j);
      end;
      bit := bit shl 1;
    end;
    Inc(id);
    mask := mask + 1;
    while (mask and (1 shl n)) <> 0 do
    begin
      mask := mask + 1;
    end;
  end;

  Result := xs;
  xs := nil;
  l := nil;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  红球基本号码: array[0..32] of string;
  红球全集: TArray<TArray<string>>;
  st: TStopwatch;
begin
  st := TStopwatch.Create;
  st.Reset;
  st.Start;
  for var i := 0 to High(红球基本号码) do
    红球基本号码[i] := Format('%.2d', [i + 1]);
  红球全集 := 组合(红球基本号码, 6);
  st.Stop;
  ShowMessage('耗时 ' + st.ElapsedMilliseconds.ToString + ' 毫秒，共 ' + Length(红球全集).ToString + ' 个组合。');
end;

end.
此帖子包含附件:
JPEG 图像
大小:232.2K
----------------------------------------------
《Python图形用户界面设计——Delphi For Python高级开发教程》、《Delphi Web 前端开发教程》：WWW.Z-SHi.NET
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/2/25 22:59:31
17楼： @qq81709989 谢谢 快是快很多 但是基本上每一组的结果是空的没有号码. 这样并行计算最大的难点是要保证结果按正常顺序输出而且变量应该需要原子操作不然有干扰.
----------------------------------------------
-
作者：
男 qq81709989 (ChatGPT-4) ▲▲△△△ -
普通会员
2023/2/25 23:20:20
18楼： 添加了多线程，未调试
function 组合(var s: array of string; const n: integer): TArray<TArray<string>>;
var
  l: array of integer;
  id, i, j: integer;
  xs: TArray<TArray<string>>;
  maxMask, mask, bit: integer;
begin
  id := 返回组合数(length(s), n);

  SetLength(xs, id, n);

  SetLength(l, n);

  maxMask := (1 shl Length(s)) - 1;
  id := 0;
  mask := 0;
  TParallel.For(0, id, procedure(i: integer)
    var
      j, bit, k: integer;
      tempMask: integer;
      temp: TArray<string>;
    begin
      tempMask := i;
      j := 0;
      bit := 1;
      SetLength(temp, n);
      for k := 0 to Length(s) - 1 do
      begin
        if (tempMask and bit) <> 0 then
        begin
          temp[j] := s[k];
          Inc(j);
        end;
        bit := bit shl 1;
      end;
      xs[i] := temp;
    end);

  Result := xs;
  xs := nil;
  l := nil;
end;
----------------------------------------------
《Python图形用户界面设计——Delphi For Python高级开发教程》、《Delphi Web 前端开发教程》：WWW.Z-SHi.NET
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/2/25 23:42:56
19楼： 这两处报错说不能捕获符号
此帖子包含附件:
JPEG 图像
大小:22.7K
----------------------------------------------
-
作者：
男 qq81709989 (ChatGPT-4) ▲▲△△△ -
普通会员
2023/2/26 8:21:03
20楼： function 组合(var s: array of string; const n: integer): TArray<TArray<string>>;
var
  sCopy: TArray<string>; // 复制一份 s
  l: array of integer;
  id, i, j: integer;
  xs: TArray<TArray<string>>;
  maxMask, mask, bit: integer;
begin
  // 复制 s
  SetLength(sCopy, Length(s));
  TArray.Copy<string>(s, sCopy, Length(s));

  id := 返回组合数(length(s), n);

  SetLength(xs, id, n);

  SetLength(l, n);

  maxMask := (1 shl Length(s)) - 1;
  id := 0;
  mask := 0;
  TParallel.For(0, id, procedure(i: integer)
    var
      j, bit, k: integer;
      tempMask: integer;
      temp: TArray<string>;
    begin
      tempMask := i;
      j := 0;
      bit := 1;
      SetLength(temp, n);
      for k := 0 to Length(sCopy) - 1 do
      begin
        if (tempMask and bit) <> 0 then
        begin
          temp[j] := sCopy[k];
          Inc(j);
        end;
        bit := bit shl 1;
      end;
      xs[i] := temp;
    end);

  Result := xs;
  xs := nil;
  l := nil;
end;
----------------------------------------------
《Python图形用户界面设计——Delphi For Python高级开发教程》、《Delphi Web 前端开发教程》：WWW.Z-SHi.NET
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/2/26 12:18:17
21楼： 第一次运行要花100多ms,奇怪的是第二次只需要30ms,但每注仍然是空白没有内容.
maxMask := (1 shl Length(s)) - 1; 这句是起什么作用呢
----------------------------------------------
-
作者：
男 roadrunner (roadrunner) ★☆☆☆☆ -
盒子活跃会员
2023/2/26 13:20:24
22楼： 把GetData换个函数名试试
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/2/26 15:32:51
23楼： @roadrunner 换个函数名可以了,但我输出倒数100注看了一下,结果不正确,有很多重复号码
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/2/27 11:58:53
24楼： 是不是要计算：每次从33个数字随机抽6个号码？还有别的要求没有？一共算几组？如果这样，花不了多少时间

如果是33中随机选6，我算了10000组不到1毫秒
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/2/27 12:54:32
25楼： @hq200306 是要把所有组合遍历出来
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/2/27 12:59:53
26楼： 我的笔记本是t480s,cpu intel 8350,算10万组不到10毫秒，遍历也花不了时间
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/2/27 13:02:01
27楼： 做好了10万组应该不到5毫秒
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/2/27 13:16:15
28楼： const

  iMaxCol = 33;
  iMaxSel = 6;

type
  Tdata = array[1..iMaxCol] of Byte;

procedure selectit(var data: Tdata); //随机数将存在data[28..33]
var
  iLastIdx: Integer;
  i: Integer;
  idx: Integer;
  iTmp: Byte;
begin

  for I := 1 to iMaxCol do
  begin
    data[i] := i;
  end;

  iLastIdx := iMaxCol;

  for I := 1 to iMaxSel do
  begin
    idx := Random(iLastIdx) + 1;

    iTmp := data[idx];
    data[idx] := data[iLastIdx];
    data[iLastIdx] := iTmp;

    dec(iLastIdx);
  end;
end;

//调用
procedure calc;
var
  data: Tdata;
  d1: TStopwatch;
  i, k: Integer;
begin
  d1 := TStopwatch.StartNew;
  Randomize;
  for k := 1 to 10000 * 10 do
  begin
    selectit(data);

    for I := iMaxCol - iMaxSel + 1 to iMaxCol do
    begin
      //随机数存在data[28..33]
    end;
  end;
  d1.Stop;
end;
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/2/27 13:21:59
29楼： 我的机算10万组33选6，约8毫秒,估计还可以进一步优化
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/2/27 15:03:59
30楼： @hq200306 总共1107568组,需要按从小到大的顺序显示出来,随机的话就不是按顺序了.
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/2/27 15:23:14
31楼： 是不是，求所有的组合，不算排列？
比如:
1,2,3,4,5,6
1,2,3,4,5,7
1,2,3,4,5,8
。。。。
28,29,30,31,32,33

算全集,对不？
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/2/27 15:36:07
32楼： @hq200306 是的,求所有组合,每组的6个号不用全排列,从小到大就行,就是您举例那样的,所有组合也按从01 02 03 04 05 06到28 29 30 31 32 33的顺序,共1107568组结果.
----------------------------------------------
-
作者：
男 kentty (kentty) ★☆☆☆☆ -
普通会员
2023/2/27 17:34:06
33楼： 这不是典型的深度搜索算法么，用递归函数，我家小孩上礼拜刚做过这样的信息课作业 :)
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/2/27 17:43:51
34楼： 求二维全集，两个循环就能解
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/2/27 22:45:20
35楼： @kentty 解决不难 思路很多 关键是效率问题 递归3毫秒估计办不到
@hq200306 这个跟二维好像没关系 有关系的话应该是6维吧 直接穷举判断后面的数必须大于前面的数吗 估计效率不高
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/2/28 0:08:21
36楼： 刚试了穷举法43ms 真不知3ms怎么搞出来的
----------------------------------------------
-
作者：
男 kentty (kentty) ★☆☆☆☆ -
普通会员
2023/2/28 11:42:22
37楼： uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, System.Diagnostics, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure dfs(x, y: Integer);
  end;

var
  Form1: TForm1;
  res: array [0 .. 5] of Integer;
  count: Integer;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  count := 0;

  var st := TStopWatch.Create;
  st.Reset;
  st.Start;
  dfs(0, 0);
  st.Stop;
  showMessage(Format('count=%d, time=%dms', [count, st.ElapsedMilliseconds]));
end;

procedure TForm1.dfs(x, y: Integer);
begin
  if x + 33 - y < 6 then
    Exit;

  if x = 6 then
  begin
    Inc(count);
    Exit;
  end;

  for var m := y to 32 do
  begin
    res[x] := m + 1;
    dfs(x + 1, m + 1);
    res[x] := 0;
  end;
end;

end.

4核心win10 x64虚拟机, 32位app@mbp2019，count=1107568,用时5ms
----------------------------------------------
-
作者：
男 kentty (kentty) ★☆☆☆☆ -
普通会员
2023/2/28 11:45:17
38楼： 多次运行，耗时在3，4，5ms之间跳动
----------------------------------------------
-
作者：
男 kentty (kentty) ★☆☆☆☆ -
普通会员
2023/2/28 11:55:04
39楼： 如果用res存储所有结果，
res: array[0..2000000] of array [0 .. 5] of Integer;
...
res[count,x] := m + 1;

用时会增加1ms左右，可能是二维数组寻址要慢一点？
----------------------------------------------
-
作者：
男 kentty (kentty) ★☆☆☆☆ -
普通会员
2023/2/28 12:01:05
40楼： dfs如果不计算m+1和恢复现场，
  for var m := y+1 to 33 do
  begin
    res[count,x] := m ;
    dfs(x + 1, m);
//    res[x] := 0;
  end;

最快可以3ms完成
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/3/1 18:53:05
41楼： @kentty 要把存储结果的数组分配空间的时间也算进去,看来时间主要花在数组的空间分配上了,这个存放结果的二维数组setlength的时间就需要27ms,我这里直接用6重循环只需要37ms比递归48ms稍快.难道别人的3ms是用的链表添加元素或者没有把分配数组空间的时间算进去.不知道有没有比setlength效率更高的分配方法.
----------------------------------------------
-
作者：
男 kentty (kentty) ★☆☆☆☆ -
普通会员
2023/3/1 21:22:07
42楼： 要想快，哪儿有频繁Setlength+1的，至少也要+1000起步

针对这道题，因为事先知道C(33,6)大约是100多万，就提前声明了一个200W*6的二维数组，剩下的交给递归，也就是3ms的事 ：）
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/3/1 21:25:45
43楼： @kentty 不是频繁,是直接setlength(res, 1107586,6)这一步就要27ms,剩下的事10ms以内,我老i7处理器.您的3ms没有保存结果所以快.
----------------------------------------------
-
作者：
男 kentty (kentty) ★☆☆☆☆ -
普通会员
2023/3/1 21:32:06
44楼： 我虚拟机Setlength(res,1107568,6)要37ms，
为什么不SetLength(res,1107568*6)呢，这个我这里5ms
----------------------------------------------
-
作者：
男 kentty (kentty) ★☆☆☆☆ -
普通会员
2023/3/1 21:38:23
45楼：  for var m := y+1 to 33 do
  begin
    res[count,x] := m ;
    dfs(x + 1, m);
  end;

递归这里res变成事先声明的二维数组，也是保存了结果的，和只保存最后一次的结果，时间差别不大
要用一维数组，无非是res[count*6+x]=m，估计和二维数组用时差不多，毕竟二维数组寻址也是要这么算一下的吧
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/3/1 22:04:15
46楼： @kentty 我这里setlength二维耗时27ms,一维耗时3ms,确实相差巨大.用二维是为了后面处理数据方便.非常感谢!如果不考虑setlength的时间能达到3ms同时还能保存结果看样子挺难的,就不奢望了.
----------------------------------------------
-
作者：
男 board4all (搬运) ▲▲▲▲▲ -
普通会员
2023/3/12 2:39:16
47楼： 我的算法在我的笔记本上(i9-12950H)运行1.2ms~1.7ms，请大家看看。
计算1000次，求平均时间

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

const
  BallCount = 33; // Max BallCount==64;
  VCount = (BallCount * (BallCount - 1) * (BallCount - 2) * (BallCount - 3) *
    (BallCount - 4) * (BallCount - 5)) div (1 * 2 * 3 * 4 * 5 * 6);

type
  TDataList = array [0 .. VCount - 1] of UInt64;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    DA: TDataList;
    procedure EnumAllValues(var DA: TDataList);
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses System.Threading, System.SyncObjs, System.Diagnostics;

const
  MoveMask: array [0 .. 63] of UInt64 = (
    1,
    UInt64(1) shl 1,
    UInt64(1) shl 2,
    UInt64(1) shl 3,
    UInt64(1) shl 4,
    UInt64(1) shl 5,
    UInt64(1) shl 6,
    UInt64(1) shl 7,
    UInt64(1) shl 8,
    UInt64(1) shl 9,
    UInt64(1) shl 10,
    UInt64(1) shl 11,
    UInt64(1) shl 12,
    UInt64(1) shl 13,
    UInt64(1) shl 14,
    UInt64(1) shl 15,
    UInt64(1) shl 16,
    UInt64(1) shl 17,
    UInt64(1) shl 18,
    UInt64(1) shl 19,
    UInt64(1) shl 20,
    UInt64(1) shl 21,
    UInt64(1) shl 22,
    UInt64(1) shl 23,
    UInt64(1) shl 24,
    UInt64(1) shl 25,
    UInt64(1) shl 26,
    UInt64(1) shl 27,
    UInt64(1) shl 28,
    UInt64(1) shl 29,
    UInt64(1) shl 30,
    UInt64(1) shl 31,
    UInt64(1) shl 32,
    UInt64(1) shl 33,
    UInt64(1) shl 34,
    UInt64(1) shl 35,
    UInt64(1) shl 36,
    UInt64(1) shl 37,
    UInt64(1) shl 38,
    UInt64(1) shl 39,
    UInt64(1) shl 40,
    UInt64(1) shl 41,
    UInt64(1) shl 42,
    UInt64(1) shl 43,
    UInt64(1) shl 44,
    UInt64(1) shl 45,
    UInt64(1) shl 46,
    UInt64(1) shl 47,
    UInt64(1) shl 48,
    UInt64(1) shl 49,
    UInt64(1) shl 50,
    UInt64(1) shl 51,
    UInt64(1) shl 52,
    UInt64(1) shl 53,
    UInt64(1) shl 54,
    UInt64(1) shl 55,
    UInt64(1) shl 56,
    UInt64(1) shl 57,
    UInt64(1) shl 58,
    UInt64(1) shl 59,
    UInt64(1) shl 60,
    UInt64(1) shl 61,
    UInt64(1) shl 62,
    UInt64(1) shl 63
  );

procedure EnumValue(Base: UInt64; BaseIndex: Integer; var DataList: TDataList;
  var Count: Integer); inline;
var
  j, k, L, M, N: Integer;
begin
  for j := 4 to BaseIndex - 1 do
  begin
    Base := Base + MoveMask[j];
    DataList[Count] := Base;
    Inc(Count);
    for k := 3 to j - 1 do
    begin
      Base := Base + MoveMask[k];
      DataList[Count] := Base;
      Inc(Count);
      for L := 2 to k - 1 do
      begin
        Base := Base + MoveMask[L];
        DataList[Count] := Base;
        Inc(Count);
        for M := 1 to L - 1 do
        begin
          Base := Base + MoveMask[M];
          DataList[Count] := Base;
          Inc(Count);
          for N := 0 to M - 1 do
          begin
          Base := Base + MoveMask[N];
          DataList[Count] := Base;
          Inc(Count);
          end;
        end;
      end;
    end;
  end;
end;

procedure TForm1.EnumAllValues(var DA: TDataList);
var
  i, Count: Integer;
  Base: UInt64;
  N: array [5 .. BallCount - 2] of Integer;
  Tasks: array [5 .. BallCount - 2] of ITask;
  T: ITask;
begin
  // 数据准备
  Base := $3F; // 6位1
  DA[0] := Base;
  Count := 1;

  for i := 5 to BallCount - 2 do
  begin
    Base := Base + MoveMask[i];
    N[i] := 0;
    DA[Count] := Base;
    Inc(Count);
    EnumValue(Base, i, DA, Count);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
  st: TStopWatch;
begin

  st := TStopWatch.Create;
  st.Reset;
  st.Start;
  for i:=0 to 999 do EnumAllValues(DA);
  st.Stop;
  ShowMessage(Format('Average Time:%f ms', [st.ElapsedMilliseconds/1000.0]));
end;

end.
此帖子包含附件:
PNG 图像
大小:2.16M
----------------------------------------------
-
作者：
男 board4all (搬运) ▲▲▲▲▲ -
普通会员
2023/3/12 10:15:24
48楼： 最大可以设置63个球，程序运行是跑的33个球。
源码与执行程序：
此帖子包含附件:board4all_2023312101524.zip 大小:1.31M
----------------------------------------------
-
作者：
男 pcplayer (pcplayer) ★☆☆☆☆ -
普通会员
2023/3/12 11:49:58
49楼： SetLength 耗时，是因为你要分配一个大内存。分配的内存越大肯定越耗时。


47楼的做法很聪明，直接声明常量，就不用运算时 SetLength 了，程序启动的时候就分配好内存了。大不了就是启动时间长一点。运算时间就省了分配内存的时间了。

对于内存分配，其实这里的简单原则就是：
1. 不要频繁做。能够一次做的，就不要做 2 次。因为内存分配很耗时。
2. 不管代码多复杂，如果很多地方都要用到相同的内存，那就初始化时，一次分配好。
3. 如果不知道需要多少，一次分配太多消耗内存，一次分配太少，运行中内存不够用了又需要重新分配，那这里有个简单的策略就是每次分配，倍增。

比如你 SetLength(S, 100);

后面 100 不够用了，有了 101，你不要 SetLength(S,101)。如果你这样搞，那下次 102 了你又得再次分配，结果就是分配内存的次数大增，导致 CPU 耗时。所以这个时候你直接来一个 SetLength(S, 200)；

当然，具体到每个不同的场景，这个倍增好，还是增加多少好，就看具体场景下程序员对内存需求的预测了。
----------------------------------------------
-
作者：
男 wk_knife (wk_knife) ★☆☆☆☆ -
盒子活跃会员
2023/3/12 16:18:04
50楼： 既然可以按顺序排，每次只计算显示的那一页就可以。存一个上次显示最后一行的次序，
如果一个分页100条，每次只计算这100条，肯定很快啊。
----------------------------------------------
-
作者：
男 wk_knife (wk_knife) ★☆☆☆☆ -
盒子活跃会员
2023/3/12 16:21:21
51楼： 即便是滚动也没有问题，把grid做下调整，就按滚动条的偏移量，计算geid里应该显示的部分。
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/17 7:37:53
52楼： 33选6，将所有的数据枚举出来，全集1107568个，计算时间大概就是2毫秒。

function Calc33: Integer;
type
  OneItem = array[1..6] of Byte;
var
  i1,
    i2,
    i3,
    i4,
    i5,
    i6: Byte;
  ic: Integer;
  i: Byte;
  iCol: OneItem;
  Item: OneItem;
begin

  for I := 1 to 6 do
  begin
    iCol[i] := 27 + i;
  end;

  ic := 0;

  for I1 := 1 to iCol[1] do
    for I2 := i1 + 1 to iCol[2] do
      for I3 := i2 + 1 to iCol[3] do
        for I4 := i3 + 1 to iCol[4] do
          for I5 := i4 + 1 to iCol[5] do
          for I6 := i5 + 1 to iCol[6] do
          begin
          Item[1] := i1;
          Item[2] := i2;
          Item[3] := i3;
          Item[4] := i4;
          Item[5] := i5;
          Item[6] := i6;
          inc(ic);
          end;

  Result := ic;
end;
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/17 8:02:20
53楼： 计算全集，共1107568个，并存入数组ArItem，我的电脑是thinkpad t480s,i5 8350u，把笔记本调到性能模式，计算机时间3毫秒，估计拿到快点的计算机，时间会更少，我想delphi做这些简单的计算，速度不会慢

function Calc33a: Integer;
type
  OneItem = array[1..6] of Byte;
var
  i1,
    i2,
    i3,
    i4,
    i5,
    i6: Byte;
  ic: Integer;
  i: Byte;
  iCol: OneItem;
  ArItem: array of OneItem;
  pItem: ^OneItem;
begin
  SetLength(ArItem, 1107568);

  for I := 1 to 6 do
  begin
    iCol[i] := 27 + i;
  end;

  ic := 0;

  for I1 := 1 to iCol[1] do
    for I2 := i1 + 1 to iCol[2] do
      for I3 := i2 + 1 to iCol[3] do
        for I4 := i3 + 1 to iCol[4] do
          for I5 := i4 + 1 to iCol[5] do
          for I6 := i5 + 1 to iCol[6] do
          begin
          pItem := @ArItem[ic];

          pItem[1] := i1;
          pItem[2] := i2;
          pItem[3] := i3;
          pItem[4] := i4;
          pItem[5] := i5;
          pItem[6] := i6;

          inc(ic);
          end;

  Result := ic;
end;
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/17 8:58:00
54楼： 33选6全集，计算时间大概3毫秒,数据存于ArItem

function Calc33a: Integer;
type
  OneItem = array[1..6] of Byte;
var
  i1,
    i2,
    i3,
    i4,
    i5,
    i6: Byte;
  ic: Integer;
  i: Byte;
  iCol: OneItem;
  ArItem: array of OneItem;
  pItem: ^OneItem;
begin
  SetLength(ArItem, (33 * 32 * 31 * 30 * 29 * 28) div 720);

  for I := 1 to 6 do
  begin
    iCol[i] := 27 + i;
  end;

  ic := 0;

  for I1 := 1 to iCol[1] do
    for I2 := i1 + 1 to iCol[2] do
      for I3 := i2 + 1 to iCol[3] do
        for I4 := i3 + 1 to iCol[4] do
          for I5 := i4 + 1 to iCol[5] do
          for I6 := i5 + 1 to iCol[6] do
          begin
          pItem := @ArItem[ic];

          pItem[1] := i1;
          pItem[2] := i2;
          pItem[3] := i3;
          pItem[4] := i4;
          pItem[5] := i5;
          pItem[6] := i6;

          inc(ic);
          end;

  Result := ic;
end;
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/17 11:38:21
55楼： 改成下面算法，耗时2毫秒，结果存于ArItem

type
  OneItem = array[1..6] of Byte;
var
  ArItem: array[0..33 * 32 * 31 * 30 * 29 * 28 div 720] of OneItem;

function Calc33a: Integer;
var
  i1,
    i2,
    i3,
    i4,
    i5,
    i6: Byte;
  ic: Integer;
  i: Byte;
  iCol: OneItem;
  pItem: ^OneItem;
begin

  for I := 1 to 6 do
  begin
    iCol[i] := 27 + i;
  end;

  ic := 0;

  for I1 := 1 to iCol[1] do
    for I2 := i1 + 1 to iCol[2] do
      for I3 := i2 + 1 to iCol[3] do
        for I4 := i3 + 1 to iCol[4] do
          for I5 := i4 + 1 to iCol[5] do
          for I6 := i5 + 1 to iCol[6] do
          begin
          pItem := @ArItem[ic];

          pItem[1] := i1;
          pItem[2] := i2;
          pItem[3] := i3;
          pItem[4] := i4;
          pItem[5] := i5;
          pItem[6] := i6;

          inc(ic);
          end;

  Result := ic;
end;
----------------------------------------------
-
作者：
男 board4all (搬运) ▲▲▲▲▲ -
普通会员
2023/3/17 22:17:32
56楼： 楼上的算法在我的电脑上跑0.89ms，
下面的优化算法在我的电脑上跑，0.37ms,如果还要快，要改汇编语言了。
type
  PUInt64=^UInt64;
var
  BrItem: array [0 .. 33 * 32 * 31 * 30 * 29 * 28 div 720 - 1] of UInt64;

function Calc33b: Integer;
var
  j1, j2, j3, j4, j5, j6,j7,j8: Byte;
  p: PUInt64;
begin
  j7:=0;
  j8:=0;
  p:=@BrItem;

  for j1 := 1 to 28 do
    for j2 := j1 + 1 to 29 do
      for j3 := j2 + 1 to 30 do
        for j4 := j3 + 1 to 31 do
          for j5 := j4 + 1 to 32 do
          for j6 := j5 + 1 to 33 do
          begin
          p^:=PUInt64(@j8)^;
          Inc(p);
          end;

  Result := 1107586;
end;
此帖子包含附件:board4all_2023317223118.zip 大小:1.27M
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/18 7:08:49
57楼： 1、按楼上方法，为了结果易读，改了下
2、relase方式编译成64位,我的电脑0.6毫秒算完，结果存于ArItemA
3、j7,j8占位用，和避免编译提示

const
  iBuff = (33 * 32 * 31 * 30 * 29 * 28) div (6 * 5 * 4 * 3 * 2 * 1);

type
  PUInt64 = ^UInt64;
  OneItemA = array[1..8] of Byte;

var
  ArItemA: array[0..iBuff - 1] of OneItemA;

function Calc33b: Integer;
var
  j8, j7, j6, j5, j4, j3, j2, j1: Byte;

  p: PUInt64;
begin
  j8 := 0;
  j7 := 0;
  p := @ArItemA;

  for j1 := 1 to 28 do
    for j2 := j1 + 1 to 29 do
      for j3 := j2 + 1 to 30 do
        for j4 := j3 + 1 to 31 do
          for j5 := j4 + 1 to 32 do
          for j6 := j5 + 1 to 33 do
          begin
          p^ := PUInt64(@j1)^;
          Inc(p);
          end;

  Result := iBuff + j7 + j8;
end;
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/18 8:50:00
58楼： 再改一下，逻辑看起来要完整一些

const
  iBuff = (33 * 32 * 31 * 30 * 29 * 28) div (6 * 5 * 4 * 3 * 2 * 1);

type
  PUInt64 = ^UInt64;
  OneItemA = array[1..8] of Byte;

var
  ArItemA: array[0..iBuff - 1] of OneItemA;

function Calc33b: Integer;
var
  j8, j7, j6, j5, j4, j3, j2, j1: Byte;

  p: PUInt64;
begin
  j8 := 0;
  j7 := 0;
  p := @ArItemA;

  for j1 := 1 to 28 do
    for j2 := j1 + 1 to 29 do
      for j3 := j2 + 1 to 30 do
        for j4 := j3 + 1 to 31 do
          for j5 := j4 + 1 to 32 do
          for j6 := j5 + 1 to 33 do
          begin
          p^ := PUInt64(@j1)^;
          Inc(p);
          end;

  Result := (UInt64(p) - UInt64(@ArItemA)) shr 3 + j7 + j8;
end;
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/18 15:19:24
59楼： 估计可以结贴了，1107586组数，我的电脑花0.59毫秒
----------------------------------------------
-
作者：
男 roadrunner (roadrunner) ★☆☆☆☆ -
盒子活跃会员
2023/3/19 12:02:33
60楼： 14楼的代码改BUG
初始化数据表的第一个循环
for i := 1 to 28 do tabledata[i,6] := i;
其中最后的 := i 改成  := 1;

这才是最优解，根本不需要预计算搞个大数组存结果，直接要第几个结果立即算出来就是
----------------------------------------------
-
作者：
男 board4all (搬运) ▲▲▲▲▲ -
普通会员
2023/3/19 15:05:04
61楼： 不搞大数组更快，更简单，0字节内存占用，运行时间平均不到0.1ms 算出任意位置的结果
function Calc33b(Index:Integer): UInt64;
var
  j1, j2, j3, j4, j5, j6,j7,j8: Byte;
begin
  if (Index<=0) or (Index>1107586) then Exit(0);
  j7:=0;
  j8:=0;

  for j1 := 1 to 28 do
    for j2 := j1 + 1 to 29 do
      for j3 := j2 + 1 to 30 do
        for j4 := j3 + 1 to 31 do
          for j5 := j4 + 1 to 32 do
          for j6 := j5 + 1 to 33 do
          begin
                Dec(Index);
              if (Index=0) then Exit(PUInt64(@j8)^)
          end;
end;
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/19 16:13:56
62楼： board4all (搬运)厉害
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/19 16:15:21
63楼： 我在考虑，是不是还有数学模型，可以直接算出来，不需要累计
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/19 16:28:45
64楼： 我个人的想法，如果没有有找到简便的数学公式，现在的计算全集时间不到1毫秒，这点时间，在使用过程中可以忽略不计，结果集放内存，反正也不大，就几兆，要用的时候直接查表得出结果，查表的时间几乎为何0，更实用。

看了roadrunner (roadrunner)14楼代码，也可以，就是不直观，但不像数学公式。
按function GetData(n:integer):TData;毕竟还是查表加计算，不是立即数，例如需要查1万个数，是不是要计算一万次？这个时间肯定不少，说是最优，我不敢相信。
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/19 22:24:16
65楼： @board4all (搬运),我测了你优化的代码中用到
p^ := PUInt64(@j8)^;

在release下，编译成64位的返回值不对，debug是对的。
估计指针指向堆栈给优化了。
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/19 22:33:30
66楼： 1、我想谁的数学好，可以直接算出来,不需要查表，也不需要累加
2、下面这段代码是能计算出61楼代码大循环的数据段，确定j1的1-28的范围
3、直接定位的数学模型我暂时没找出来，但这段代码可以配合61楼的代码，算出j1,能提高几倍速度


procedure TForm4.Button2Click(Sender: TObject);
var
  i: Integer;
  k: Integer;
  tmp: Integer;
  tmp1: Integer;
  j1: Integer;
begin
  ListBox1.Clear;

  tmp1 := 0;
  j1 := 1;

  for k := 33 downto 6 do
  begin
    tmp := 1;
    for I := 1 to 5 do
    begin
      tmp := tmp * (k - i);
    end;

    tmp := tmp div (5 * 4 * 3 * 2 * 1);

    tmp1 := tmp1 + tmp;

    ListBox1.Items.Add('j1:' + j1.ToString + ', ' + tmp.ToString + ', ' + tmp1.ToString);

    inc(j1);
  end;

end;
----------------------------------------------
-
作者：
男 roadrunner (roadrunner) ★☆☆☆☆ -
盒子活跃会员
2023/3/19 23:11:28
67楼： 56楼的代码是很危险的, delphi并不保证会把循环变量的值写回内存, 所以这个代码是有可能会出问题的

如果你们对纯pascal代码优化有兴趣的话，我将55楼的代码改改，你们可以对比一下我的代码和你们的代码的性能，这代码是针对64位Release模式优化的，在32位下性能也应该不错, 不挑CPU，在ARM下也没问题

type
//注意这里OneItem数据类型定义的改动，每项数据长度从6字节改到8字节提升速度
  OneItem = Record
  case integer of 
    0 : (U : UInt64);
      1 : (data : array[1..6] of Byte);
  end;
var
  ArItem: array[0..33 * 32 * 31 * 30 * 29 * 28 div 720] of OneItem;

function Calc33a: Integer;
var
  R : UInt64;
  pItem: ^OneItem;
begin
  pItem := @ArItem[0];
  R :=$060504030201;
  repeat
    pItem.U := R;
    inc(PItem);
    if R > $210000000000 then
      if R > $212000000000 then
  if R > $21201f000000 then
    if R > $21201f1e0000 then
      if R > $21201f1e1d00 then
        if R = $21201f1e1d1c then break
        else begin
    var t : UInt64 := R and $ff;
    R := ((((t shl 8+t) shl 8+t)shl 8+t)shl 8+t)shl 8+t+$60504030201;
        end
      else begin
        var t : UInt64 := R and $ff00;
        R := (((t shl 8+t)shl 8+t)shl 8+t)shl 8+$50403020100+R and $ffff;
      end
    else begin
      var t : UInt64 := R and $ff0000;
      R := ((t shl 8+t)shl 8+t)shl 8+$40302010000+R and $ffffff;
    end
  else begin
    var t : UInt64 := R and $ff000000;
    R := (t shl 8 +t)shl 8+$30201000000+R and $ffffffff;
  end
      else R := R and $ff00000000 shl 8+$20100000000+R and $ffffffffff
    else R := R+$10000000000;
  until false;
  Result := 1107586;
end;
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/19 23:13:58
68楼： @roadrunner (roadrunner)老兄,应该有数学公式，我初步能算出28个数据段
----------------------------------------------
-
作者：
男 roadrunner (roadrunner) ★☆☆☆☆ -
盒子活跃会员
2023/3/19 23:36:43
69楼： 我发在67楼的代码，应该可以打赢一般人的手写汇编，不过不排除有BUG ;P 记事本写的，没测试过

@hq200306
很显然第一位的数值求解是求一个五次方程的解, 这不大可能有简便方法, 查表应该是最简单的, 看我的60楼和14楼，查表法循环不到100次就可以求得6个位置数值，还嫌不够快甚至优化成折半查找都是可以的
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/20 8:23:19
70楼： 定位的技术方法，我思路有了，还需细化，定位不需要查表,不需要遍历，能算出来
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/21 18:37:07
71楼： 根据67楼改进一下，67楼在我的机运行1.37毫秒，下面代码0.83毫秒，之前0.6毫秒结果不正确,这次算是真正突破1毫秒

unit Un33f;

interface

const
  iBuff = (33 * 32 * 31 * 30 * 29 * 28) div (6 * 5 * 4 * 3 * 2 * 1);

type

  pOneItemG = ^OneItemG;
  OneItemG = record
    case integer of
      0: (U: Int64);
      1: (data: array[1..6] of Byte);
  end;
var
  ArItemG: array[0..iBuff - 1] of OneItemG;

function Calc33g: Integer;

implementation

function Calc33g: Integer;
var
  i1,
    i2,
    i3,
    i4,
    i5,
    i6: Int64;
  itmp2,
    itmp3,
    itmp4,
    itmp5: Int64;
  pItem: pOneItemG;
begin
  pItem := @ArItemG;

  for I1 := 1 to 28 do
  begin
    for I2 := i1 + 1 to 29 do
    begin
      itmp2 := i1 + i2 shl 8;
      for I3 := i2 + 1 to 30 do
      begin
        itmp3 := itmp2 + i3 shl 16;
        for I4 := i3 + 1 to 31 do
        begin
          itmp4 := itmp3 + i4 shl 24;
          for I5 := i4 + 1 to 32 do
          begin
          itmp5 := itmp4 + i5 shl 32;
          for I6 := i5 + 1 to 33 do
          begin
          pItem.U := itmp5 + i6 shl 40;
          inc(pItem);
          end;
          end;
        end;
      end;
    end;
  end;

  Result := iBuff;
end;

end.
----------------------------------------------
-
作者：
男 roadrunner (roadrunner) ★☆☆☆☆ -
盒子活跃会员
2023/3/21 22:48:52
72楼： 楼上说一下你的delphi版本和运行模式?
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/21 22:52:59
73楼： Thinkpad T480s intel i5 8350u 16G内存 
Win11 21h2 - 22000.1696
Delphi 11.3 release 编译成 win64

55楼  2毫秒
67楼  1.37毫秒
71楼  0.83毫秒
都在一个程序，不同单元
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/22 23:16:15
74楼： 定位我算出来了，不到千分之1毫秒，是有数学模型的
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/22 23:20:52
75楼： @roadrunner (roadrunner)你好，麻烦你整理一下定位代码，发上来，我测试一下，你14楼及60楼的代码计算结果不对。
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/23 9:17:45
76楼： 我是用组合公式算出来了，不枚举情况，算出一个数我的电脑平均0.6微妙
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/24 8:26:30
77楼： 再改进一下，不枚举，在我的电脑能平均不到0.2微秒，直接算出一条结果
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/24 10:39:46
78楼： 我的结论
1、我把1107568个数代入所写的函数计算，共花182毫秒，平均求每个组合的计算要0.17微秒，显然大批量比枚举慢很多，枚举全组合不需要一毫秒，虽然枚举要占8兆内存,这点内存对现在电脑不值一提。
2、如果一次取5000条以下，直接计算花的时间更少，毕竟求一次组合不到0.2微妙，反之，先枚举出来，再利用枚举的结果。

我想，这个问题可以结贴了。
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/24 21:05:29
79楼： 下面代码在给定数值[1..1107568]直接计算出组合值,我的电脑约0.17微秒

unit Un33b;

interface

type
  rtnItem = array[1..6] of byte;

procedure getItemC(iv: Integer; var vItem: rtnItem);

implementation

const
  iMaxV = 1107568;

type
  pCombKey33 = ^CombKey33;
  CombKey33 = record
    idx: integer;
    value: Integer;
    preValue: Integer;
  end;

procedure getCombValue(kStart, kEnd: Integer; iv: Integer; p: pCombKey33);
var
  i: Integer;
  k: Integer;
  m,
    n,
    ca: Integer;
  iTemp: Integer;
  idx: Integer;
  preValue: Integer;
begin
  ca := 0;
  idx := 0;
  preValue := 0;
  iTemp := kStart - kEnd;

  for k := kStart downto iTemp do
  begin
    m := 1;
    n := 1;
    for I := 1 to iTemp - 1 do
    begin
      m := m * (k - i);
      n := n * i;
    end;
    inc(ca, m div n);

    p.preValue := preValue;
    preValue := ca;

    if ca >= iv then
    begin
      p.idx := idx;
      p.value := ca;
      exit;
    end;

    inc(idx);
  end;
end;

procedure getItemC(iv: Integer; var vItem: rtnItem);
var
  i: Integer;
  idx: Integer;
  k1,
    k2: Integer;
  p: CombKey33;
begin
  if (iv < 1) or (iv > iMaxV) then
  begin
    for I := 1 to 6 do
    begin
      vItem[i] := 0;
    end;

    exit;
  end;

  for I := 1 to 6 do
  begin
    vItem[i] := i + 27;
  end;

  k1 := 33;
  k2 := 27;
  idx := 1;

  for I := 1 to 6 do
  begin
    getCombValue(k1, k2, iv, @p);
    Dec(k1);

    if p.value = iv then
    begin
      vItem[i] := idx + p.idx;

      exit;
    end
    else if p.idx > 0 then
    begin
      dec(iv, p.preValue);
      inc(idx, p.idx);

      dec(k1, p.idx);
      dec(k2, p.idx);
    end;

    vItem[i] := idx;
    inc(idx);
  end;
end;

end.
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/3/27 23:58:35
80楼： @hq200306 为什么要用shl运算呢 能解释下原理吗
----------------------------------------------
-
作者：
男 2cc (2cc) ▲△△△△ -
普通会员
2023/3/28 1:02:54
81楼： @mp654kk
左移(shl)运算比乘法速度快，所以用左移，不需要浮点寄存器，就一句汇编指令。
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/28 8:23:39
82楼： @mp654kk请在你的电脑用delphi的release、64位模式将71,楼，79楼编译，试一下函数的运算时间。
这个问题的数学模式是52楼
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/3/30 19:29:51
83楼： 谢谢大家 @2cc原来如此 @hq200306 我的电脑release、64位模式71楼只取一个0毫秒 全部取出177毫秒 79楼2毫秒 byte会比integer操作快吗
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/30 19:52:19
84楼： 1、@mp654kk (mp654kk) 你在83楼搞反了71楼和79楼的测试结果,71楼是全枚举，应该是几毫秒,我的电脑不到1毫秒；79楼是取一条，不可能是0毫秒，大概0.17微妙

2、byte不会比integer快，只是空间小了，1个字节和4字节区别

3、我大概知道你的cpu的速度了，你的i7速度还比不上我的笔记本的i5,我建议你测试71楼上是测1000次，取平均
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/3/30 22:59:40
85楼： @hq200306 嗯 我说反了 但是我发现71楼有很多结果data里6个数都是0
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/3/30 23:05:23
86楼： 本人菜鸟问个弱智问题,安卓环境下能否利用NDK进一步提高执行效率呢,得会c++才行吗?
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/30 23:25:23
87楼： @mp654kk (mp654kk)，71楼怎么可能是0？你仔细检查程序，你是不是改的71楼的数据类型？结果我都验证过都是正确的。

如果你对Delphi不熟，可以去用55楼的代码
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/30 23:26:21
88楼： NDK就是c
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/3/30 23:41:13
89楼： 什么都没改过 大概从第301个结果开始就是0了
此帖子包含附件:
PNG 图像
大小:52.1K
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/30 23:44:01
90楼： procedure TForm4.Button11Click(Sender: TObject);
var
  d1: TStopwatch;
  ic: Integer;
  i: Integer;
  p: pOneItemG;
  idx: Integer;
begin
  ListBox1.Clear;

  d1 := TStopwatch.StartNew;
  ic := Calc33g;
  d1.Stop;
  Caption := ic.ToString + '/' + d1.ElapsedMilliseconds.ToString;

  idx := 301;
  p := @ArItemG[idx - 1];
  ListBox1.Items.Add(p.data[1].ToString);
  ListBox1.Items.Add(p.data[2].ToString);
  ListBox1.Items.Add(p.data[3].ToString);
  ListBox1.Items.Add(p.data[4].ToString);
  ListBox1.Items.Add(p.data[5].ToString);
  ListBox1.Items.Add(p.data[6].ToString);
end;
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/30 23:44:56
91楼： @mp654kk (mp654kk 试一下上面代码，不会错的,你要检查你的程序有没有重复定义ArItemG
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/3/30 23:52:42
92楼： @ hq200306没问题了 看来是监视列表的问题.
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/30 23:53:42
93楼： 你算1000次，看多少时间
var
  d1: TStopwatch;
  ic: Integer;
  i: Integer;
begin
  ListBox1.Clear;

  d1 := TStopwatch.StartNew;
  for I := 1 to 1000 do
    ic := Calc33g;
  d1.Stop;
  Caption := ic.ToString + '/' + d1.ElapsedMilliseconds.ToString;
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/3/31 0:00:41
94楼： @hq200306 2649毫秒 
NDK就是c 要是delphi能自动翻译成c那就牛逼了
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/31 0:12:52
95楼： 你的电脑是I7，我的是8代的i5,计算速度是我i5的1/3速度，我的电脑是0.8毫秒跑完，估计你测试环境不对
1、不要在调试状态运行
2、编译选项“Optimization”打钩
3、编译选项“Stack Frames”打钩
4、你再看一下其它编译参数，我想不可能这么慢，估计你还有编译参数不对
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/3/31 0:21:42
96楼： 这两个勾上了 没有在编译状态下运行 这次2654 其实正常我这是老掉牙的4代i7,某宝买的二手货
Intel(R) Core(TM) i7-4790K CPU @ 4.00GHz   4.00 GHz
跟你有代差
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/31 0:24:09
97楼： 那比我的电脑慢太多了，我的电脑也不快，t480s,i5 8350u 16G内存，我还有台t490s，比这台快10%
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/3/31 0:29:39
98楼： 我这内存还是3代的 DDR3 1600MHz
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/31 0:37:24
99楼： 我的是ddr4-3200，cpu三级缓存6兆，估计硬件比的快
我的电脑有时0.78毫秒能跑完
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/3/31 0:45:27
100楼： 佩服佩服 有办法不会C也可以用NDK提高程序性能吗 网上不是说Delphi使用android的NDK是通过JNI接口，封装好了，不用自己写本地代码，直接调用吗。
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/3/31 0:50:11
101楼： delphi写的安卓代码就是native，和c一样的,包括linux也是一样
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/3/31 0:55:37
102楼： 意思是fmx做出来的安卓程序不是翻译成java而是直接翻译成了C 已经使用ndk编译成非托管代码了吗 这么厉害
----------------------------------------------
-
作者：
男 pcplayer (pcplayer) ★☆☆☆☆ -
普通会员
2023/3/31 16:27:37
103楼： 我觉得楼上有几个概念搞混了。

1. 调用这个概念：
通过 JNI 调用 Android NDK，那是【调用】。相当于有人写了库，这个库是个类似 DLL 的东西，你去调用。只不过安卓系统里面的库，是 JAVA 的，Delphi 或者 C++ 这种语言不能像调用 DLL 那样去调用，需要通过 JNI。

既然是调用别人的库，效率就是看那个库本身了，和你的语言没什么关系。

2. 编译这个概念
至于 C 或者 C++ 那是直接编译成了机器码，而不是 JAVA 的字节码。
Delphi 也是直接编译成了机器码，而不是编译成了 C 或者 JAVA。

理论上，机器码的运行效率比字节码高。不过现在据说 JAVA 的字节码在运行时也会动态编译成机器码再运行了，效率也没问题。我这个说法也是老黄历了，现在具体安卓环境下是个什么情况，得看看近年的资料。
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/3/31 19:49:06
104楼： @pcplayer 那fmx程序在安卓下没调用JNI的话依然是托管代码吗 容易被破解是吗 如何提高破解难度呢
----------------------------------------------
-
作者：
男 pcplayer (pcplayer) ★☆☆☆☆ -
普通会员
2023/4/1 0:59:11
105楼： 104 楼，Delphi 编译的程序，是真正的基于对应的 CPU 的机器码。如果要说破解，那也是破解机器码，也就是反编译二进制的代码为汇编。


Java 虚拟机的字节码，理论上可以反编译为 Java 代码。网上查了一下，在 https://www.apkeditor.cn/?bd_vid=8237607553980235205 这个网页里面提供安卓程序的反编译，其中它说：

通过本功能可以导出完整的Android Studio代码，并通过将反编译出来的资源文件和配置文件，按照智能向导自动生成Android Studio项目，如果项目没有混淆，导出的Java代码只需要通过少量的手工修改即可正常打包运行。

说明目前的安卓 Java 程序，依然还是编译成 JAVA 字节码，可以反编译为 Java 源代码。这种模式下，为了防止别人反编译，一般做法就是代码混淆，也就是把代码写乱，你反编译出来的代码很乱没法读。

至于 Delphi 和 C 这样的编译为目标 CPU 机器码的程序，反编译后最多也就是汇编代码，无法获得 Delphi 的代码。我记得以前在 Windows 底下有工具可以把 Delphi 的程序反编译出 Delphi 的代码，但结果并不是很好，反编译的结果基本上不能直接用。

总之，Delphi 编译的程序，你就当它在 Windows 底下的程序一样就对了。

但要说破解，这世界上，矛和盾，没用哪一个最厉害的，只看个人水平。
----------------------------------------------
-
作者：
男 hawke2e (hawke2e) ★☆☆☆☆ -
普通会员
2023/4/1 10:23:02
106楼： 楼上： 现在有了机器学xi，C C++ delphi lazarus编译的二进制代码估计大概率能被破解。除非是人用汇编写有针对性的写才有可能暂时不能破解。
实际上，打造分布式可信环境才是解决此问题的根本，整个系统代码分成若干段都不知道分布在哪台机器上运行，怎么破？
----------------------------------------------
软件是什么，相信很多人都说不清。
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/4/2 18:02:36
107楼： @pcplayer @hawke2e 意思是fmx弄出来的apk文件安装到手机上已经是机器码了吗 比直接用java开发的破解难度高吗
----------------------------------------------
-
作者：
男 pcplayer (pcplayer) ★☆☆☆☆ -
普通会员
2023/4/3 0:52:34
108楼： 107 楼：你去看 Delphi 编译的安卓程序，虽然最终是一个 APK，但 APK 只是一个打包，真正的 Delphi 编译的程序是一个 .so 文件。这个 .so 实际上是 Linux 底下的一个动态库，类似 Windows 底下的 DLL 文件。Delphi 号称是真正的编译的目标 CPU 的机器码。

破解难度当然比 JAVA 编译的字节码更高。
----------------------------------------------
-
作者：
男 pcplayer (pcplayer) ★☆☆☆☆ -
普通会员
2023/4/3 1:07:59
109楼： 其实，无需纠结破解问题。

1. 你的程序如果没有很多人用，没人有兴趣去破解。
2. 你的程序如果很多人用，有巨大的市场和收益，当然就会有人想破解。
3. 破解是需要花费成本的，是否需要去破解，得看预期收益有多大；
4. 当你的程序能够走到很多人用的地步，你已经有很多收益了，这个时候，你投入更多的钱来加密也好搞什么技术也好来防止破解，也是要投入成本的，但这个时候你已经有更多的钱来投入这个成本了；
5. 加密 - 破解，就是矛和盾的关系，没有最厉害的矛，也没有最厉害的盾，就看谁的投入更多。而投入多少，就看值得不值得。
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/4/6 18:11:24
110楼： @ pcplayer 太好了,delphi的确牛,所言极是.
----------------------------------------------
-
作者：
男 dbyoung (dbyoung) ★☆☆☆☆ -
普通会员
2023/4/6 21:08:42
111楼： 看来 pcplayer 大侠这段时间不是一般的闲。
----------------------------------------------
武汉天气不好
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/4/19 12:33:40
112楼： 现在有个问题来了,我们知道01 02 03 04 05 06是第一个结果,28 29 30 31 32 33是最后一个结果,那比如01 05 08 09 18 28这注号码是第几个结果有办法直接算出来吗?不把所有结果算出来查找看它是第几注而是直接算出来,.这个算法好像比较复杂.
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/4/19 13:10:56
113楼： @mp654kk (mp654kk)如果你能看得懂79楼的算法，应该可以直接出结果
----------------------------------------------
-
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/4/19 13:55:50
114楼： @hq200306 没看懂呢,那个是给定序号得出结果,现在是给定结果得出序号了.
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2023/4/19 15:07:15
115楼： @mp654kk 这纯粹是数学问题，等你研究清楚了就可以了。
如果速度要求不高，61楼的方法通用，如果要速度，需要弄清楚79楼的算法。
----------------------------------------------
-
信息
登陆以后才能回复
Copyright © 2CCC.Com 盒子论坛 v3.0.1 版权所有 页面执行258.9111毫秒 RSS