DELPHI盒子
!实时搜索: 盒子论坛 | 注册用户 | 修改信息 | 退出
检举帖 | 全文检索 | 关闭广告 | 捐赠
技术论坛
 用户名
 密  码
自动登陆(30天有效)
忘了密码
≡技术区≡ ①
DELPHI技术
移动应用开发
Web应用开发
数据库专区
报表专区
网络通讯
开源项目
论坛精华贴
≡发布区≡ ②
发布代码
发布控件
文档资料
经典工具
≡事务区≡ ③
网站意见
盒子之家
招聘应聘
信息交换
论坛信息
最新加入： l_hx
今日帖子： 5
在线用户： 2
导航： 论坛 -> DELPHI技术 斑竹:liumazi,sephil  
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/2/24 1:15:49
标题：
新手好奇fmx里程序效率优化问题探讨 浏览:2126
加入我的收藏
楼主： 同样一个功能别人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 (Z-SHi战石) ▲▲△△△ -
普通会员
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 GUI设计Delphi从入门到实践》、《Delphi Web 前端开发教程》：WWW.Z-SHi.NET
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/2/25 22:59:31
17楼： @qq81709989 谢谢 快是快很多 但是基本上每一组的结果是空的没有号码. 这样并行计算最大的难点是要保证结果按正常顺序输出而且变量应该需要原子操作不然有干扰.
----------------------------------------------
-
作者：
男 qq81709989 (Z-SHi战石) ▲▲△△△ -
普通会员
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 GUI设计Delphi从入门到实践》、《Delphi Web 前端开发教程》：WWW.Z-SHi.NET
作者：
男 mp654kk (mp654kk) ▲△△△△ -
普通会员
2023/2/25 23:42:56
19楼： 这两处报错说不能捕获符号
此帖子包含附件:
JPEG 图像
大小:22.7K
----------------------------------------------
-
作者：
男 qq81709989 (Z-SHi战石) ▲▲△△△ -
普通会员
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 GUI设计Delphi从入门到实践》、《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楼的代码计算结果不对。
----------------------------------------------
-
信息
登陆以后才能回复
Copyright © 2CCC.Com 盒子论坛 v3.0.1 版权所有 页面执行210.9375毫秒 RSS