注册 登录
编程论坛 VB6论坛

各位老师好!求助编辑一个大整数的快速乘除法可调用程序

ysr2857 发布于 2020-02-10 23:10, 28921 次点击
我用于判断和筛选10亿内的素数表的程序速度太慢,1亿内的需要3个小时,10亿内的更是24个小时没有结果,只好关闭了,已经是采用了快速判断法,但效果低,原因是不会大整数的快速乘除法程序,希望老师帮助。我仅会一点VB语句,希望是用VB编程的。
我的判断素数的程序,对单个整数几十位的可以迅速判断,素数表就不行了,只能到1亿,单个整数100位以上的也不行。希望老师指点,会快速乘法除法的原理的也请指导帮助!
谢谢!
   祝愿各位老师,新年快乐,阖家幸福安康,万事如意!

[此贴子已经被作者于2020-2-10 23:14编辑过]

401 回复
#202
ysr28572020-03-07 18:41
朋友的注释共有17张图片,我注释了4张,发了末尾3张,还有10张没有弄懂看不清楚没有发,不懂原理,通过末尾3张注释看大致是:把乘数被乘数由多项式系数表示法变为点值表示,通过快速fft,再相乘,结果变为系数表示法,用快速逆fft变换。不懂vc语句,有懂的感兴趣的老师朋友,请给与指导,谢谢!
#203
ysr28572020-03-12 14:35
2^101-1=2535301200456458802993406410751=7432339208719*341117531003194129,
这么大的梅森数,如下网站可以分解:WolframAlpha
最大能分解多少不知道,我也没有登录,只是在网上见到了图片,图片中的例子就是前面的这个数。我的程序还没有达到这样的速度和效率,正在研究完善这样的理论和方法。
关于RSA密码的破解,据网上说已经能分解700多位的整数,所以1024或2048位的密码才是安全的。
我的分解整数的原理是特殊数域法,1024或2048位的整数理论上是应该能分解的,但由于程序速度慢效率低,根本达不到要求,只能分解几十位的且时间长,慢到无法忍受。
前面这个网站的程序就可以分解大整数,不知道能分解到多少位的?
欢迎感兴趣的沟通,欢迎指导!欢迎发表快速乘法除法程序,最好是VB版的。
咱不是黑客,不当黑客,只是为了研究整数的规律。黑客用的编程工具据说大多是汇编语言和c语言,没有用vb语言。即使能分解这么大的整数也不可能破解密码,没有黑客程序去哪里得到密码?仅是说明一下可能性,量子计算机的研制速度在提高,RSA密码体制必然面临淘汰,需要改进或重新建立新的密码体制。(秀尔算法据说可以破解RSA密码,咱不懂原理,据说其中的一个步骤必须用量子计算机,还要结合传统计算机才能破解密码)
#204
ysr28572020-03-15 16:45
下面是计算和判断梅森数的程序,仅发主程序供大家参考,希望得到快速乘法除法程序以提高这个程序的速度:(判断法采用卢卡斯-莱莫测试法)
 Private Sub Command1_Click()
Dim a
a = Val(Text1)
B = 1
Do While C <= a - 1
B = MbC(Trim(B), 2)
C = C + 1
Loop
Text2 = MPC(Trim(B), 1)
End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""

End Sub
 

Private Sub Command3_Click()
Dim a
B = Trim(Text1)
B1 = 1
Do While C <= B - 1
B1 = MbC(Trim(B1), 2)
C = C + 1
Loop
a = MPC(Trim(B1), 1)

If Len(a) <= 11 Then
Text3 = fenjieyinzi(Trim(a))
Else
Text3 = fenjieyinzi1(Trim(a), Val(B))
End If
End Sub

Private Function fenjieyinzi1(sa As String, sb As String) As String
Dim X, B
X = Trim(sa)

 B = Val(sb)
 s = 4
 B1 = 0
Do While B1 <= B
If InStr(MCC1(Trim(s), Trim(X)), "/") = 0 Then
a = True
Else
a = a
End If
B1 = B1 + 1
s1 = zhengchuqyushu(MCC1(Trim(s), Trim(X)))
s2 = s2 & s1 & "(" & B1 & ")" & vbCrLf
s = MPC(MbC(Trim(s1), Trim(s1)), 2)
Loop
If a = True Then
fenjieyinzi1 = "这是素数" & s2
Else
fenjieyinzi1 = "2*2" & s2
End If

End Function
#205
ysr28572020-03-24 14:57
回复 199楼 ysr2857
199楼的vc程序谁能直接翻译成vb程序?有朋友说不必先弄懂原理,可以直接翻译成basic程序的,只要运行没有错误就行。
#206
ysr28572020-04-01 08:20
如下为网上搜索到的快速乘法的c语言程序,请老师看看能不能运行?能不能翻译成vb程序?
迭代型:(共119行,乱了,再整理一下)
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <stdbool.h>
#include <math.h>
#include <conio.h>
#define N 150010const double pi = 3.141592653;
char s1[N>>1], s2[N>>1];
double rea[N], ina[N], reb[N], inb[N];
int ans[N>>1];
 void Swap(double *x, double *y)
{
    double t = *x;
    *x = *y;
    *y = t;
}
 int Rev(int x, int len)
{
    int ans = 0;
    int i;
   for(i = 0;
 i < len; i++)
{
       ans <<= 1;
        ans |= (x & 1);
        x >>= 1;
    }
    return ans;
}
 void FFT(double *reA, double *inA, int n, bool flag)
{
   int s;
    double lgn = log((double)n) / log((double)2);
    int i;
    for(i = 0; i < n; i++)
{  
      int j = Rev(i, lgn);
        if(j > i)
{
            Swap(&reA[i], &reA[j]);
            Swap(&inA[i], &inA[j]);
        }
    }
   for(s = 1; s <= lgn; s++)
{   
     int m = (1<<s);
        double reWm = cos(2*pi/m), inWm = sin(2*pi/m);
        if(flag) inWm = -inWm;
        int k;
        for(k = 0; k < n; k += m)
{  
          double reW = 1.0, inW = 0.0;
            int j;
           for(j = 0; j < m / 2; j++)
{  
              int tag = k+j+m/2;
                double reT = reW * reA[tag] - inW * inA[tag];
                double inT = reW * inA[tag] + inW * reA[tag];
               double reU = reA[k+j], inU = inA[k+j];
                reA[k+j] = reU + reT;
                inA[k+j] = inU + inT;
                reA[tag] = reU - reT;
               inA[tag] = inU - inT;
               double rew_t = reW * reWm - inW * inWm;
                 double inw_t = reW * inWm + inW * reWm;
                reW = rew_t;
               inW = inw_t;
           }
        }
    }
    if(flag)
{
        for(i = 0;
 i < n; i++)
{
            reA[i] /= n;
            inA[i] /= n;
        }
   }
}
 int main()
{
#if 0
   freopen("in.txt","r",stdin);
#endif
   while(~scanf("%s%s", s1, s2))
{
       memset(ans, 0 , sizeof(ans));
        memset(rea, 0 , sizeof(rea));
        memset(ina, 0 , sizeof(ina));
        memset(reb, 0 , sizeof(reb));
        memset(inb, 0 , sizeof(inb));
        int i, lent, len = 1, len1, len2;
        len1 = strlen(s1);
        len2 = strlen(s2);
        lent = (len1 > len2 ? len1 : len2);
        while(len < lent) len <<= 1;
        len <<= 1;
        for(i = 0;
 i < len; i++)
{
           if(i < len1) rea[i] = (double)s1[len1-i-1] - '0';
            if(i < len2) reb[i] = (double)s2[len2-i-1] - '0';
            ina[i] = inb[i] = 0.0;
        }
        FFT(rea, ina, len, 0);
        FFT(reb, inb, len, 0);
        for(i = 0; i < len; i++)
{
           double rec = rea[i] * reb[i] - ina[i] * inb[i];
            double inc = rea[i] * inb[i] + ina[i] * reb[i];
            rea[i] = rec; ina[i] = inc;
        }
        FFT(rea, ina, len, 1);
        for(i = 0; i < len; i++)
           ans[i] = (int)(rea[i] + 0.4);
        for(i = 0; i < len; i++)
{
           ans[i+1] += ans[i] / 10;
            ans[i] %= 10;
        }
        int len_ans = len1 + len2 + 2;
        while(ans[len_ans] == 0 && len_ans > 0)
 len_ans--;
        for(i = len_ans; i >= 0; i--)
            printf("%d", ans[i]);
       printf("\n");
    }
    return 0;
}
————————————————
迭代型比递归型稍快一点。
发帖时间 昨天 09:18
        
#207
ysr28572020-04-14 09:06
回复 197楼 wmf2014
没人研究这个了?结贴,给你加分!
#208
ysr28572020-04-21 12:40
只有本站会员才能查看附件,请 登录
朋友说前面的c语言程序缺少图中下面画红线的库,谁知道?怎么补?哪里找?
#209
ysr28572021-03-19 18:03
我自己编程的利用快速傅里叶变换的大整数的乘法程序结果(似乎也不快,没有优化,结果还不可靠,有时候中间不确定位置会出现错误数字):
111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*111111111=12345678999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999987654321有221位,用时1.347656秒.(这个结果应该是对的)

再继续研究一下吧!
#210
ysr28572021-03-19 18:22
这个是用我的模仿手工乘法的程序计算结果:(比快速傅里叶变换的还快?)
111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*111111111=12345678999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999987654321有221位,用时0.0078125秒.
#211
ysr28572021-03-19 18:28
删了一条没有用的程序,似乎快了一点,看起来快速傅里叶变换有提升空间的:
111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*111111111=12345678999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999987654321有221位,用时0.78125秒.
#212
ysr28572021-03-19 18:35
把数据设定提到前面,省略了中间的重复部分,居然速度又提高了一点:
111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*111111111=12345678999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999987654321有221位,用时0.734375秒.
#213
ysr28572021-03-19 18:54
额,我用差程序了,用的是没有调整好的程序,改回来后结果全是对的,就是速度慢了!!需要研究优化:
11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*101=1122222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222211有331位,用时2.648438秒.

不知道如何优化,希望老师指点!
#214
ysr28572021-03-19 19:43
回复 160楼 ysr2857
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801*
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801=
2678145490787694710138406683675886762424440548647327525594133873038347266950777818028529804877891353347244255046176220880989519574806598935727647635506939520211209794328712328126947740602255036264392628020291100698432900022333877728824270241063030019536831205264726059774673235680796770108334187808344470141093691232926021244583649747591446066921535333854157441330339217364515328375889937313870826987520723914810358707312468857074455945610038118763873992681688857200178452843740327143990247797893489008808544535536081089994800692174759199578596435124153437689121057209523619989593900355037400039597165241729693472001589594642879166693443994939359639600558001937547209387175085119128575833396037478944824322315197771750730768383267287661855880237549141571520374996029107650341071074081501632143441365461865431362023790463469688071768208320226561675630348708531708110373889241713511809029065048200924851629507265095151843687852114948736130517024578482059771284515915597919026074110811882700307150650858080695566672584075215926450360584738705106755945308199980660478183563586945902705730231409948938478910176292179410952310592864745025373902249844607078729230098512959498522851990040833671698873183076996740726479481352429756295966452788332789259316653805673821716832204368483794501474641036177256005810416507649770210480747056764697918800240201155395628561684853684747063434500664449114760179367086926249813006056735202795763742271472136500817313178050955623517148960973128433455798444839070215800699075256371341531892841721456473301085595261371522078416420399702683504171019191363372883472415693921509069484448792009627325245658854979159002549542769741504596589556474585723101403486046952706847309188488390899096649210853675228464611999630360164703837131620319658277117300208326944026347808645954842782309633205645471959842390075986572806483755223497552549948718545978420793425036666212191832327909389117021539426917904222971515424022606157676379417252939026404363841301595348953340657745965591468370831371449860774296757556463049237248472613472436666799615694672489600751763956185893123579218797539971253828850163437053164723845196089466298000486042246621634263064752906475198879616484926366053597071510886820878425907736453843197228282179943365206039514850477377542684361730162273246709577442085159313947668552462343596819299335060863266863059421286080919061657175757802930378698062290163092494909661982639303946271889619023417245433500782685534406291391527022657608608130680134939380126048353657648559735671562230714451258764762350451448379438849319710473631625533527602085050858633346936315115309333355986556546113134787213610042970405680162084678021281774169131725296977361816657904233850711837826724976507876061043779177845550646612327663283839673950405472039432309339110648301347672597370034346896334064135099613033528785924976781865447506814375627647103020761819104412269362847848884053177378762432543285984193091289854949394023586451139393716370633759317698908834326333339634557238526607966375935960004339535161203546369910853171524516945554862019134684985868547068709986010719120259421723270478586992153989283736650948010894951434857207445141886625290777550599700738909777829412358941157674866550887608199469723859806486384262574182811908513849905040209776132986875560077482527819093584150609347560543627976011009349905362597935257895287412087233810106693141683912683308201407373637490835862452911394718399632093441745957478079754723679119343225931665785380948807114301164623717144211285944154289093317610519159281033583963015810556464180819928345256832572962092994993950655913067768151113345566231088759030148164710287289335782462899525700500822021472132532771242198844498579102733028256523810973405350508253183399668290339844052874956694050028526577775764032598023622192221226501334606994447870277619118208162133562541678250491647671042612088902952091163094215645902682086024337098910110924115381788866213335441814530141911754446270296630426675020592640816713810936850961517475097707179713115856513919631998747192606018612535436009162735908155778165736923393260822217415131632296810207091918499370220533980666393617256227781299273913099896641458499949922475383775878771011361417556799406151773618626138749998464514570482965286184387350245762317271666329142667987131139265167425606863654107927682419958167046956962340419295394058625063862272314570914511355913547470055072878835349142049813368019960713974852351833144227544851625677753419141348585495260230041111323576432417502998832485027071744397105338790364666312325483218209150368759120749671419554589928540715813531144241705501211397506662448276056294585639532800634727428900861538486753011006379264618338782036690340859441153926551954112364946638768223012718907190897165613382555036872673785444132692292217184974818914501886689736449912131900762592363447945036085692999163815947845753538999001633767986447907729462453017601有4888位,用时24.8125秒.

还不如106#楼的模仿手工计算的程序快呢,咋回事?
#215
ysr28572021-03-19 19:49
回复 141楼 xianfajushi
147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369*36985214=5468351513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317507871966有403位,用时1.4375秒.

改变一下算法,采用8位一段如何?还有效吗,傅里叶变换?
#216
ysr28572021-03-19 20:38
速度基本无法再提高了,改一下算法,改为8位一组试试,如何呢?如下是优化后的代码(还没有改成8位一组的):
Dim l As Long, le As Long, le1 As Long, n As Long, r As Long, p As Long, q As Long, m As Byte
  Dim wr As Double, w1 As Double, wlr As Double, wl1 As Double, tr As Double, t1 As Double
  Dim pi As Double, t As Double, tr1 As Double

Private Sub Command1_Click()
  Dim xr() As Double, a As String
  a = Trim(Text1)
  b = Trim(Text3)
  ts = Timer
  sb1 = Len(a) + Len(b)
  sb2 = Log(sb1) / Log(2)
  If InStr(sb2, ".") = 0 Then
  sb2 = sb2
  Else
  sb2 = Int(sb2) + 1
  End If
  sb = 2 ^ sb2
  Print sb
  If Len(a) = Len(b) And 2 ^ (Int(Log(Len(a)) / Log(2))) = Len(a) Then
    a = String(Val(sb) - Len(a), "0") & a
  b = String(Val(sb) - Len(b), "0") & b
  a = dxcx0(Trim(a), Val(sb)): b = dxcx0(Trim(b), Val(sb))
  Else

  a = String(Val(sb) - Len(a), "0") & a
  b = String(Val(sb) - Len(b), "0") & b
  a = dxcx0(Trim(a), Val(sb)): b = dxcx0(Trim(b), Val(sb))
  End If
  ReDim xr(0 To Len(a) - 1): ReDim yr(0 To Len(b) - 1): ReDim zr(0 To Len(b) - 1)
  For i1 = 0 To Len(a) - 1
  xr(i1) = Mid(a, i1 + 1, 1)
  yr(i1) = Mid(b, i1 + 1, 1)

     Next
  
  Dim xi(): Dim yi(): Dim zi()
  n = Len(a) '求数组大小,其值必须是2的幂
m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > n
  n = l / 2
  ReDim xi(n - 1): ReDim yi(n - 1): ReDim zi(n - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     
      p = p + le
  Loop Until p > n - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For i = 0 To n - 1 '仅输出模
   zr(i) = xr(i) * yr(i) - xi(i) * yi(i): zi(i) = xr(i) * yi(i) + xi(i) * yr(i)
      

      s = s & "/" & zr(i)
      s1 = s1 & "/" & zi(i)
      Next
     s2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)), Trim(sb1))
     
      Text2 = s2 & "有" & Len(s2) & "位,用时" & Timer - ts & "秒"
  End Sub

  Private Sub Command2_Click()
  Text1 = ""
  Text2 = ""
  Text3 = ""
  Form1.Cls
  End Sub

Private Function qdqd0(sa As String) As String
  a = sa
  Do While Left(a, 1) = "0"
  a = Mid(a, 2)
  Loop
  If a = "" Then
  a = 0
  Else
  a = a
  End If
  qdqd0 = a
  End Function


  Private Function nifft(sa As String, sb As String, sb1 As String) As String
  
  Dim xi(): Dim yi(): Dim zi()
  Dim xr(), yr(), zr()
  s2 = Split(sa, "/")
  s3 = Split(sb, "/")
      j = UBound(s2)
      n = j
     For k = 1 To j
         n1 = n1 + 1
          ReDim Preserve xr(0 To n1 - 1)
          ReDim Preserve yr(0 To n1 - 1)
         xr(n1 - 1) = s2(n1): yr(n1 - 1) = s3(n1)
       Next
     

  ReDim zr(0 To j - 1)

  m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > n
  n = l / 2
  ReDim xi(n - 1): ReDim yi(n - 1): ReDim zi(n - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = -1 * pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     
      p = p + le
  Loop Until p > n - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For i = 0 To n - 1 '仅输出模
zr(i) = (xr(i) - yi(i)) / n
      
     
      s1 = Int(Val(zr(i) + 0.5))
      s = "/" & s1 & s
      zr(i) = s1
      Next
      For i1 = 1 To Val(j - sb1 + 1)
      zr(sb1 + i1 - 2) = 0
      Next
      
     
     
      For i1 = 0 To n - 1
      If zr(i1) < 0 Then
      zr(i1) = 0
      Else
      zr(i1) = zr(i1)
      End If
      
      
      If i1 = 0 Then
      s6 = Int(zr(i1)) \ 10
      s8 = Int(zr(i1)) Mod 10
      ElseIf Val(zr(i1)) >= 0 Then
      s7 = Int(zr(i1)) + Val(s6)
      s10 = Val(s7) Mod 10
      s11 = s10 & s11
      s6 = Val(s7) \ 10
      Else
      s6 = Val(s6)
      End If
     
      Next
      s9 = s6 & s11 & s8
     
  nifft = qdqd0(Trim(s9))

  End Function

  Private Function dxcx0(sa As String, sb As String) As String

  Dim x_() As Double, a As String
    a = Trim(sa)
    ReDim x_(1 To sb)
    For i1 = 1 To sb
    x_(i1) = Mid(a, sb - i1 + 1, 1)
      Next
    Dim n As Integer, i As Long, j As Long, mn As Long, lh As Long, t As Double, k As Long
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    j = n / 2
    For i = 1 To n - 2


    Debug.Print i, j
    k = lh '下面是向右进位算法
Do
    If k > j Then Exit Do '高位是1吗
j = j - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
j = j + k '非则若最高位是0,则置1
    s = s & x_(j + 1)
    Next
    dxcx0 = x_(1) & x_(1 + sb / 2) & s
   

  End Function

  Private Function dxcx1(sa As String) As String

  Dim x_() As Double, a As String
    a = Trim(sa)
     

  s2 = Split(sa, "/")
  s3 = Split(sb, "/")
      j = UBound(s2)
      sb = j
     
       ReDim x_(1 To sb)
     For k = 1 To j
         n1 = n1 + 1
          ReDim Preserve x_(1 To n1)
        
         x_(n1) = s2(n1)
       Next
    Dim n As Integer, i As Long, mn As Long, lh As Long, t As Double
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    j = n / 2
    For i = 1 To n - 2


    Debug.Print i, j
    k = lh '下面是向右进位算法
Do
    If k > j Then Exit Do '高位是1吗
j = j - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
j = j + k '非则若最高位是0,则置1
    s = s & "/" & x_(j + 1)
    Next
    dxcx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & s
   
    End Function


[此贴子已经被作者于2021-3-19 20:44编辑过]

#217
ysr28572021-03-19 23:49
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801*
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801=
267860459079267671019097378483244816E+150771E+159584E+154721E+150426E+154463E+162237E+162459E+166889E+166698E+162648E+164567E+164327E+160047E+162881E+166135E+166848E+167676E+162187E+164428E+160996E+165865E+164758E+160404E+164707E+168979E+161123E+168343E+160077E+165343E+164366E+163828E+167852E+168099E+163817E+164248E+160839E+164693E+167301E+165932E+169046E+164184E+169274E+170211E+169476E+161344E+169739E+176197E+172849E+160415E+165937E+172816E+177045E+179629E+171532E+179208E+173033E+178107E+173816E+179491E+174891E+175073E+173994E+175989E+172918E+171636E+178926E+177829E+170956E+172619E+173936E+175187E+176138E+171752E+174649E+179897E+172426E+178741E+179812E+179706E+173001E+176466E+177246E+171237E+173302E+175178E+170651E+178395E+170714E+173394E+177646E+177899E+179186E+178975E+173822E+174831E+179544E+174097E+173001E+173958E+171916E+170719E+170759E+171775E+178223E+173977E+173438E+178827E+179348E+177758E+178058E+173643E+171253E+172471E+177256E+176915E+175898E+170543E+170138E+176937E+171978E+176347E+176015E+175663E+179118E+170179E+176331E+176245E+170494E+170312E+172036E+178301E+177797E+178535E+170344E+175114E+175011E+174354E+170667E+174616E+175084E+175432E+175812E+174218E+171145E+171739E+178244E+177064E+173092E+170644E+171112E+175448E+170265E+173345E+170403E+170169E+172747E+177204E+171813E+177117E+172609E+171098E+174442E+172204E+175964E+178919E+172988E+177313E+173108E+177438E+174734E+176021E+170132E+173686E+175998E+171642E+173835E+177956E+173554E+178544E+171508E+177074E+170412E+175404E+173858E+178623E+177994E+170178E+170545E+174095E+171123E+172376E+172829E+174681E+173586E+176937E+172086E+173464E+173383E+177771E+173244E+178985E+174765E+178189E+173737E+173392E+173687E+176396E+179966E+176867E+172267E+179348E+174682E+171962E+175608E+171281E+176054E+176627E+170513E+179632E+176321E+171321E+173836E+179016E+170449E+172669E+179798E+175471E+176268E+174256E+172846E+178911E+176499E+174072E+178623E+172225E+172224E+179508E+176249E+170504E+179144E+171906E+178974E+172751E+177971E+174818E+175605E+176242E+178972E+172335E+178479E+173148E+173073E+172215E+172057E+175897E+179721E+173449E+174999E+173162E+174508E+178948E+170118E+179689E+176978E+175925E+179386E+178023E+175311E+177391E+176959E+173498E+172244E+172713E+178286E+174506E+179454E+172678E+174166E+170265E+178477E+178678E+171148E+173347E+170158E+173192E+176268E+171478E+171609E+178452E+173631E+178539E+179061E+176654E+174758E+174846E+176292E+171594E+171643E+178267E+175811E+174791E+178585E+175927E+171131E+177444E+173762E+170047E+170755E+171097E+170256E+172759E+174051E+173405E+178463E+174182E+177901E+178919E+178734E+171902E+177183E+178442E+171431E+176027E+172938E+179528E+175177E+170134E+177631E+179658E+170564E+172997E+174632E+175826E+170468E+179063E+176671E+176122E+179567E+177502E+171022E+176255E+172984E+171133E+172804E+177249E+176813E+170449E+173498E+174159E+176431E+176803E+170083E+178515E+179921E+170582E+177734E+177682E+179066E+177931E+172382E+170838E+179342E+177106E+172011E+178756E+179181E+172533E+172822E+176628E+171874E+175758E+177442E+170571E+178575E+170169E+179766E+173819E+174372E+177259E+177599E+177341E+173585E+179944E+179366E+177287E+177277E+179707E+178278E+173684E+179838E+172211E+178805E+179827E+176986E+177905E+174217E+173332E+172569E+178807E+179045E+175336E+177165E+179809E+175341E+176091E+177325E+173793E+170204E+174908E+174783E+173804E+176642E+177914E+174258E+176319E+170259E+172323E+171831E+172399E+174834E+176105E+177524E+170681E+177062E+172213E+172096E+174798E+170966E+174636E+178974E+179888E+174162E+170337E+176146E+179509E+173701E+176434E+175731E+170447E+175292E+179308E+172586E+179981E+178945E+174957E+174501E+178396E+175035E+170946E+179026E+174688E+173649E+179807E+175481E+173864E+179963E+170733E+170255E+176366E+170164E+171155E+172045E+175334E+171192E+178818E+172282E+176336E+176551E+175496E+175257E+170014E+175597E+173182E+175127E+175318E+171735E+174191E+178849E+178921E+176781E+173382E+173724E+179305E+178218E+177246E+170751E+175136E+175739E+174139E+179052E+172786E+172389E+170467E+172458E+172288E+179613E+171824E+175178E+176726E+177299E+174513E+174907E+171568E+177575E+172374E+173638E+179393E+171534E+177198E+170666E+172318E+173546E+172502E+176251E+176548E+170534E+179171E+179505E+173235E+173782E+170308E+172051E+179927E+172542E+171173E+175196E+172549E+173342E+179686E+171684E+175128E+175462E+174152E+178226E+170577E+176184E+174602E+170022E+178376E+172241E+177299E+172978E+172255E+175459E+175993E+171615E+177305E+176924E+179855E+179843E+176277E+165683E+177453E+174824E+174654E+170906E+178743E+168065E+161364E+168646E+162158E+164232E+166112E+161973E+163113E+167774E+162167E+164069E+163987E+162919E+162049E+164163E+164809E+166556E+160564E+162945E+167787E+169363E+168731E+162756E+165237E+162626E+169394E+166027E+161639E+167853E+165286E+163496E+168265E+167573E+162311E+163907E+161636E+166383E+168407E+153144E+165245E+151056E+168182E+168583E+161298E+168303E+164523E+154445E+157729445553016961有4888位,用时3.109375秒

这是啥?速度还行,咋回事?位数好像也对了,巧了?荒唐,不可思议!各位老师晚安吧,不行了改为4位一组试试,明天再说,晚安!!
#218
ysr28572021-03-19 23:58
147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369*36985214=
1.931.931.931.931.931.931.931.931.931.931.931.931.931.931.93688410879246E+159896E+150488E+154032E+15175005115893E+156033E+155133E+15838062999246E+159896E+150488E+154032E+15175005135893E+156033E+155133E+15838062969246E+159896E+150488E+154032E+15175005105893E+156033E+155133E+15838062959246E+159896E+150488E+154032E+15175005135893E+156033E+155133E+15838062999246E+159896E+150488E+154032E+15175005155893E+156033E+155133E+15838062989246E+159896E+150318E+1507871970有460位,用时0.1953125秒

真是奇怪的结果,可能是无法摆脱科学计数法的缘故,咋弄?咋就不用科学计数法了?改成4位一组试试?
#219
ysr28572021-03-20 00:02
11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*101=11111111111111111111111111111111111111111111111122222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222211有377位,用时0.3589973秒.

错误结果,咋调整不过来呢?
#220
ysr28572021-03-20 01:57
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801*
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801=
2678543790793380710194816683886586764715440574327327883594135783038388326951102618031717804920971353627844258232176243790989868374810182935778107635972439523097209826418712704526949494602274456264734228022995100733762900266333878923824295581063251019540499205312286060107673239910796787608334357208346488141115751233206821247117649774911446358421536885854186191330548217364994328407469937602370830445520755734810522907314168857091755945971338120859874025301689214000181787843755827144190647800299489027108544741736084811994843732175105699580676435146583437818521058972523643129594128255038848039616185241791693472565589606782879391793446202939373479600778001940012209404435085253728577757396056018945016322316550771772690768597467288463855885527549277571522895996046407650613471074489501660943441073261863732362001630463259688070370208302656561453030347708531676210373694841710965809011985048073324849822507238755151748087849912948712820516770978480576771255815915295719023010110796882699948550648198080664366672315375212762450347734738424306753917308167660660053883558464945875835729821209945420478864136291904610948454592829885024984702246563607038369229862712956016522828830040455871694885183041116740426379476330429723465966082188330127259275053805306921711704204338163794021874638223177207625810184507645206210422637056229297914240240152315395055361678829684701543433803864442878760116867086386849806722056683112795315542267311136437097312662450948229517115210972499833449727444775970215555099067852371292651892193321451326301030955261027722071028420331912682849171012712363305703471791593915421069430928791224227318433658786179158329849533705741448196588894274578621101318186046280806839873188423880898261649203521675148864611149330351240703786391619518658268378300113446943332447799939954781122308609805637819959757470075225272797323755143967551496148711358978325853424299866202495832241969388211021531183917797762970810724013338157607489416346739019521363729241594720653330327745892881467495831364261860678576756836063038375248393693471542266790872694571029599781663946203893048929217801139963261828761203436278264712947195998546297006286033617621518323064058906466458879535124925258053588733510794180877580107723767843106438281141743354574039403290476599942674725730080123245606377434173159210887667564362331662819195945060034666853726421169080918312457165977802810888696772890154144494804981981567603933467889534413415979833490201685416126290360627011919608528700678922539371571048243557647455035660854230619211257692562341507448240858848417010462563625432737600801850845158346833195114446133344964556470323133770213600878970299280161074078009545774088631723983377353910657800493849883737814714976404906060109779168713550528572326738183829233950305452038361709331413648198667671778170022006896247524133939013024769785801016780760847497368375541137101806161810664412155442846687484041209378666412542204184182018289752709393056286439659393625560632399117688011834225233338871557227544607864225934929004329358161102186369023653161110516864174860989934675922868431568709104010706678259295293269525586983127989193496650132610886201434767287444083686616457777447839699914809766185412286441156842466543683608097489722868406480342262494562810796713841451040111276132055775551309482454559092633150602039560455807975282009341189362532445256753087402737233752666692598583905673308146207372930290827903452833054717834832086037745891968078996923672480343144571665192280940907114232044623162144206416944064109092735410513699280960043962291010550920180741028344671832564668092929143949985313062707151037125565238988754134148112750286760935777040899485300500189721466826532709952198120898575025732954396523390273399802508198223398848890334429052834636693755928519031775720462597483622187514226432494606612947864689619081398161665562536987250420367670571412083142952034913093871245900222085980937098692910920847381773206212972241811833141876494446027596627684675003272640465913808591850914657474732307177413115840173919071998746197606000452535287309159781908130148165346323392046822191995131456596808043091901559369859133975797393612416227801599271559099873371458373749921359383740898770744961416740799398401773279626137101998456974570424565284550387336345762296271667001142633967130936365166135606855984107689082419655167030616962291019294220058612663862141314570852511325473547312055073588835354572049786168020885713978772351847244226716851628047753354341349977495251030040893623574990417495888832341227070047397114678790467466311575483228829150361359121719671423114590001540715181531154241705445811396128662449096056345685639196800615247428909261539806753016026379275318340016036700990859483953925783954104904946747368223558718921840897193213383185036875213785261732694338217196754818960901886503736454992131942062592257447937846085796199164450947842813538998101634085986467097729434453017585有4888位,用时4.607422秒.
时间不慢,末尾几位不对了好像是,再说吧,晚安!!
#221
ysr28572021-03-20 02:03
代码如下,加了大整数加法程序,因为最后变换得到的数组会超过15位的,有时候可能是有3*8=24位,所以8位一组不好,最好4位,最多弄5位的可能是就可以了,有可能可以省去大数加法程序。明天试试吧,今天的程序如下:

Dim l As Long, le As Long, le1 As Long, n As Long, r As Long, p As Long, q As Long, m As Byte
  Dim wr As Double, w1 As Double, wlr As Double, wl1 As Double, tr As Double, t1 As Double
  Dim pi As Double, t As Double, tr1 As Double

Private Sub Command1_Click()
  Dim xr() As String, a As String
  a = Trim(Text1)
  b = Trim(Text3)
  ts = Timer
  x = Len(a) \ 8: Y = Len(b) \ 8
  If Val(8 * x) = Len(a) Then
  a = a
  ElseIf Val(8 * Y) = Len(b) Then
  b = b
  Else
  a = String(Val(x * 8 + 8 - Len(a)), "0") & a
  b = String(Val(Y * 8 + 8 - Len(b)), "0") & b
  x = x + 1: Y = Y + 1
  End If
  
  
  sb1 = x + Y
  sb2 = Log(sb1) / Log(2)
  If InStr(sb2, ".") = 0 Then
  sb2 = sb2
  Else
  sb2 = Int(sb2) + 1
  End If
  sb = 2 ^ sb2
  Print sb
  

  a = String(Val(sb) * 8 - Len(a), "0") & a
  b = String(Val(sb) * 8 - Len(b), "0") & b
  a = dxcx0(Trim(a), Val(sb)): b = dxcx0(Trim(b), Val(sb))
  Print a
  ReDim xr(0 To (Len(a) - 8) \ 8): ReDim yr(0 To (Len(b) - 8) \ 8): ReDim zr(0 To (Len(b) - 8) \ 8)
  If Len(a) = 8 Then
  xr(0) = a: yr(0) = b
  Else
  For i1 = 0 To (Len(a) - 8) \ 8
  xr(i1) = Mid(a, (i1 + 1) * 8 - 7, 8)
  yr(i1) = Mid(b, (i1 + 1) * 8 - 7, 8)

     Next
     End If
  
  Dim xi(): Dim yi(): Dim zi()
  n = Len(a) \ 8 '求数组大小,其值必须是2的幂
m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > n
  n = l / 2
  ReDim xi(n - 1): ReDim yi(n - 1): ReDim zi(n - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     xr(p) = Format(Val(xr(p)), "0.000000"): xi(p) = Format(Val(xi(p)), "0.000000")
     yr(p) = Format(Val(yr(p)), "0.000000"): yi(p) = Format(Val(yi(p)), "0.000000")
     Print xr(p), xr(q)
      p = p + le
  Loop Until p > n - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For I = 0 To n - 1 '仅输出模
   zr(I) = xr(I) * yr(I) - xi(I) * yi(I): zi(I) = xr(I) * yi(I) + xi(I) * yr(I)
      zr(I) = Format(Val(zr(I)), "0.000000"): zi(I) = Format(Val(zi(I)), "0.000000")

      s = s & "/" & zr(I)
      s1 = s1 & "/" & zi(I)
      Next
     s2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)), Trim(sb1))
     
      Text2 = s2 & "有" & Len(s2) & "位,用时" & Timer - ts & "秒"
  End Sub

  Private Sub Command2_Click()
  Text1 = ""
  Text2 = ""
  Text3 = ""
  Form1.Cls
  End Sub

Private Function qdqd0(sa As String) As String
  a = sa
  Do While Left(a, 1) = "0"
  a = Mid(a, 2)
  Loop
  If a = "" Then
  a = 0
  Else
  a = a
  End If
  qdqd0 = a
  End Function


  Private Function nifft(sa As String, sb As String, sb1 As String) As String
  
  Dim xi(): Dim yi(): Dim zi()
  Dim xr(), yr()
  Dim zr() As String
  
  s2 = Split(sa, "/")
  s3 = Split(sb, "/")
      J = UBound(s2)
      n = J
     For k = 1 To J
         n1 = n1 + 1
          ReDim Preserve xr(0 To n1 - 1)
          ReDim Preserve yr(0 To n1 - 1)
         xr(n1 - 1) = s2(n1): yr(n1 - 1) = s3(n1)
         xr(n1 - 1) = Format(Val(xr(n1 - 1)), "0.000000"): yr(n1 - 1) = Format(Val(yr(n1 - 1)), "0.000000")

       Next
     

  ReDim zr(0 To J - 1)

  m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > n
  n = l / 2
  ReDim xi(n - 1): ReDim yi(n - 1): ReDim zi(n - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = -1 * pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     xr(p) = Format(Val(xr(p)), "0.000000"): xi(p) = Format(Val(xi(p)), "0.000000")
     yr(p) = Format(Val(yr(p)), "0.000000"): yi(p) = Format(Val(yi(p)), "0.000000")
      p = p + le
  Loop Until p > n - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For I = 0 To n - 1 '仅输出模
zr(I) = (xr(I) - yi(I)) / n
      zr(I) = Format(Val(zr(I) + 0.5), "0.000000")
     If InStr(zr(I), ".") = 0 Then
     s1 = zr(I)
     Else
     s1 = Left(zr(I), InStr(zr(I), ".") - 1)
      End If
      s = "/" & s1 & s
      zr(I) = s1
      Next
      For i1 = 1 To Val(J - sb1 + 1)
      zr(sb1 + i1 - 2) = 0
      Next
      
     
     
      For i1 = 0 To n - 1
      If zr(i1) < 0 Then
      zr(i1) = "00000000"
      Else
      zr(i1) = zr(i1)
      End If
      s5 = s5 & "/" & zr(i1)
      
      If i1 = 0 Then
      If Len(zr(i1)) < 8 Then
      zr(i1) = String(8 - Len(zr(i1)), "0") & zr(i1)
      Else
      zr(i1) = zr(i1)
      End If
      s6 = Val(Left(zr(i1), Len(zr(i1)) - 8))
      If Len(s6) < 8 Then
      s6 = String(8 - Len(s6), "0") & s6
      Else
      s6 = s6
      End If
      s8 = Right(zr(i1), 8)
      ElseIf Val(zr(i1)) >= 0 Then
      s7 = MPC1(Trim(zr(i1)), Trim(s6))
      s10 = Right(s7, 8)
      s11 = s10 & s11
      If Len(s7) < 8 Then
      s7 = String(8 - Len(s7), "0") & s7
      ElseIf Len(s7) = 8 Then
      s6 = "00000000"
      Else
      s7 = s7
      s6 = Val(Left(s7, Len(s7) - 8))
      End If
      Else
      s6 = s6
      End If
     
      Next
      s9 = s6 & s11 & s8
     
  nifft = qdqd0(Trim(s9))

  End Function

  Private Function dxcx0(sa As String, sb As String) As String

  Dim x_() As String, a As String
    a = Trim(sa)
    ReDim x_(1 To sb)
    For i1 = 1 To sb
    x_(i1) = Mid(a, (sb - i1 + 1) * 8 - 7, 8)
    If Len(x_(i1)) < 8 Then
    x_(i1) = String(8 - Len(x_(i1)), "0") & x_(i1)
    Else
    x_(i1) = x_(i1)
    End If
   
      Next
    Dim n As Integer, I As Long, J As Long, mn As Long, lh As Long, t As Double, k As Long
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
    s = s & x_(J + 1)
    Next
    dxcx0 = x_(1) & x_(1 + sb / 2) & s
   
   

  End Function

  Private Function dxcx1(sa As String) As String

  Dim x_() As Double, a As String
    a = Trim(sa)
     

  s2 = Split(sa, "/")
  s3 = Split(sb, "/")
      J = UBound(s2)
      sb = J
     
       ReDim x_(1 To sb)
     For k = 1 To J
         n1 = n1 + 1
          ReDim Preserve x_(1 To n1)
        
         x_(n1) = Format(Val(s2(n1)), "0.000000")
       Next
    Dim n As Integer, I As Long, mn As Long, lh As Long, t As Double
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
x_(J + 1) = Format(Val(x_(J + 1)), "0.000000")
    s = s & "/" & x_(J + 1)
    Next
    x_(1) = Format(Val(x_(1)), "0.000000"): x_(1 + sb / 2) = Format(Val(x_(1 + sb / 2)), "0.000000")
    dxcx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & s
   
    End Function

Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
Dim x, Y '两数长度

If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
d3 = D1
Else
D4 = D2
d3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(d3): Y = Len(D4)
Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
ReDim a(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim E1(1 To x)
Dim I, J, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
B1(J) = Mid$(D4, J, 1) '每位数
For I = x To 1 Step -1  'D1
   a(I) = Mid$(d3, I, 1) '每位数
   C1(I) = a(I) + B1(I) + JW '计算jia
   JW = C1(I) \ 10
   E1(I) = C1(I) Mod 10
  Next
  Next
  For r = 1 To x
  If JW = 0 Then
  MPC1 = MPC1 & E1(r)
  Else
  jc = jc & E1(r)
  MPC1 = JW & jc
  End If
  Next
  
End Function

#222
ysr28572021-03-20 02:12
回复 220楼 ysr2857
2678145490787694710138406683675886762424440548647327525594133873038347266950777818028529804877891353347244255046176220880989519574806598935727647635506939520211209794328712328126947740602255036264392628020291100698432900022333877728824270241063030019536831205264726059774673235680796770108334187808344470141093691232926021244583649747591446066921535333854157441330339217364515328375889937313870826987520723914810358707312468857074455945610038118763873992681688857200178452843740327143990247797893489008808544535536081089994800692174759199578596435124153437689121057209523619989593900355037400039597165241729693472001589594642879166693443994939359639600558001937547209387175085119128575833396037478944824322315197771750730768383267287661855880237549141571520374996029107650341071074081501632143441365461865431362023790463469688071768208320226561675630348708531708110373889241713511809029065048200924851629507265095151843687852114948736130517024578482059771284515915597919026074110811882700307150650858080695566672584075215926450360584738705106755945308199980660478183563586945902705730231409948938478910176292179410952310592864745025373902249844607078729230098512959498522851990040833671698873183076996740726479481352429756295966452788332789259316653805673821716832204368483794501474641036177256005810416507649770210480747056764697918800240201155395628561684853684747063434500664449114760179367086926249813006056735202795763742271472136500817313178050955623517148960973128433455798444839070215800699075256371341531892841721456473301085595261371522078416420399702683504171019191363372883472415693921509069484448792009627325245658854979159002549542769741504596589556474585723101403486046952706847309188488390899096649210853675228464611999630360164703837131620319658277117300208326944026347808645954842782309633205645471959842390075986572806483755223497552549948718545978420793425036666212191832327909389117021539426917904222971515424022606157676379417252939026404363841301595348953340657745965591468370831371449860774296757556463049237248472613472436666799615694672489600751763956185893123579218797539971253828850163437053164723845196089466298000486042246621634263064752906475198879616484926366053597071510886820878425907736453843197228282179943365206039514850477377542684361730162273246709577442085159313947668552462343596819299335060863266863059421286080919061657175757802930378698062290163092494909661982639303946271889619023417245433500782685534406291391527022657608608130680134939380126048353657648559735671562230714451258764762350451448379438849319710473631625533527602085050858633346936315115309333355986556546113134787213610042970405680162084678021281774169131725296977361816657904233850711837826724976507876061043779177845550646612327663283839673950405472039432309339110648301347672597370034346896334064135099613033528785924976781865447506814375627647103020761819104412269362847848884053177378762432543285984193091289854949394023586451139393716370633759317698908834326333339634557238526607966375935960004339535161203546369910853171524516945554862019134684985868547068709986010719120259421723270478586992153989283736650948010894951434857207445141886625290777550599700738909777829412358941157674866550887608199469723859806486384262574182811908513849905040209776132986875560077482527819093584150609347560543627976011009349905362597935257895287412087233810106693141683912683308201407373637490835862452911394718399632093441745957478079754723679119343225931665785380948807114301164623717144211285944154289093317610519159281033583963015810556464180819928345256832572962092994993950655913067768151113345566231088759030148164710287289335782462899525700500822021472132532771242198844498579102733028256523810973405350508253183399668290339844052874956694050028526577775764032598023622192221226501334606994447870277619118208162133562541678250491647671042612088902952091163094215645902682086024337098910110924115381788866213335441814530141911754446270296630426675020592640816713810936850961517475097707179713115856513919631998747192606018612535436009162735908155778165736923393260822217415131632296810207091918499370220533980666393617256227781299273913099896641458499949922475383775878771011361417556799406151773618626138749998464514570482965286184387350245762317271666329142667987131139265167425606863654107927682419958167046956962340419295394058625063862272314570914511355913547470055072878835349142049813368019960713974852351833144227544851625677753419141348585495260230041111323576432417502998832485027071744397105338790364666312325483218209150368759120749671419554589928540715813531144241705501211397506662448276056294585639532800634727428900861538486753011006379264618338782036690340859441153926551954112364946638768223012718907190897165613382555036872673785444132692292217184974818914501886689736449912131900762592363447945036085692999163815947845753538999001633767986447907729462453017601-
2678543790793380710194816683886586764715440574327327883594135783038388326951102618031717804920971353627844258232176243790989868374810182935778107635972439523097209826418712704526949494602274456264734228022995100733762900266333878923824295581063251019540499205312286060107673239910796787608334357208346488141115751233206821247117649774911446358421536885854186191330548217364994328407469937602370830445520755734810522907314168857091755945971338120859874025301689214000181787843755827144190647800299489027108544741736084811994843732175105699580676435146583437818521058972523643129594128255038848039616185241791693472565589606782879391793446202939373479600778001940012209404435085253728577757396056018945016322316550771772690768597467288463855885527549277571522895996046407650613471074489501660943441073261863732362001630463259688070370208302656561453030347708531676210373694841710965809011985048073324849822507238755151748087849912948712820516770978480576771255815915295719023010110796882699948550648198080664366672315375212762450347734738424306753917308167660660053883558464945875835729821209945420478864136291904610948454592829885024984702246563607038369229862712956016522828830040455871694885183041116740426379476330429723465966082188330127259275053805306921711704204338163794021874638223177207625810184507645206210422637056229297914240240152315395055361678829684701543433803864442878760116867086386849806722056683112795315542267311136437097312662450948229517115210972499833449727444775970215555099067852371292651892193321451326301030955261027722071028420331912682849171012712363305703471791593915421069430928791224227318433658786179158329849533705741448196588894274578621101318186046280806839873188423880898261649203521675148864611149330351240703786391619518658268378300113446943332447799939954781122308609805637819959757470075225272797323755143967551496148711358978325853424299866202495832241969388211021531183917797762970810724013338157607489416346739019521363729241594720653330327745892881467495831364261860678576756836063038375248393693471542266790872694571029599781663946203893048929217801139963261828761203436278264712947195998546297006286033617621518323064058906466458879535124925258053588733510794180877580107723767843106438281141743354574039403290476599942674725730080123245606377434173159210887667564362331662819195945060034666853726421169080918312457165977802810888696772890154144494804981981567603933467889534413415979833490201685416126290360627011919608528700678922539371571048243557647455035660854230619211257692562341507448240858848417010462563625432737600801850845158346833195114446133344964556470323133770213600878970299280161074078009545774088631723983377353910657800493849883737814714976404906060109779168713550528572326738183829233950305452038361709331413648198667671778170022006896247524133939013024769785801016780760847497368375541137101806161810664412155442846687484041209378666412542204184182018289752709393056286439659393625560632399117688011834225233338871557227544607864225934929004329358161102186369023653161110516864174860989934675922868431568709104010706678259295293269525586983127989193496650132610886201434767287444083686616457777447839699914809766185412286441156842466543683608097489722868406480342262494562810796713841451040111276132055775551309482454559092633150602039560455807975282009341189362532445256753087402737233752666692598583905673308146207372930290827903452833054717834832086037745891968078996923672480343144571665192280940907114232044623162144206416944064109092735410513699280960043962291010550920180741028344671832564668092929143949985313062707151037125565238988754134148112750286760935777040899485300500189721466826532709952198120898575025732954396523390273399802508198223398848890334429052834636693755928519031775720462597483622187514226432494606612947864689619081398161665562536987250420367670571412083142952034913093871245900222085980937098692910920847381773206212972241811833141876494446027596627684675003272640465913808591850914657474732307177413115840173919071998746197606000452535287309159781908130148165346323392046822191995131456596808043091901559369859133975797393612416227801599271559099873371458373749921359383740898770744961416740799398401773279626137101998456974570424565284550387336345762296271667001142633967130936365166135606855984107689082419655167030616962291019294220058612663862141314570852511325473547312055073588835354572049786168020885713978772351847244226716851628047753354341349977495251030040893623574990417495888832341227070047397114678790467466311575483228829150361359121719671423114590001540715181531154241705445811396128662449096056345685639196800615247428909261539806753016026379275318340016036700990859483953925783954104904946747368223558718921840897193213383185036875213785261732694338217196754818960901886503736454992131942062592257447937846085796199164450947842813538998101634085986467097729434453017585=
9999601699994313999943589999789299997708999974319999641999998089999958939999675199996811999956919999719399996813999977089999651199996415999949539999534499997113999967909999623599998245999980579999658399997295999964669999755999998804999974659999778999996331999952439999666999995769999982499999830599997981999977939999719199997465999972679999708499998447999971249999790999999520999968419999711499996541999968179999835799998299999982699999638699997903999967379999643199996664999984499999799599997593999981699999793799996277999956959999653499997919999977569999870599998236999976859999772099998551999980979999937999999435999987859999774899997791999986159999779999997534999982739999865399998075999981459999807999998646999978039999785799999197999994709999863999997478999982699999727599999591999971200000292200001699000022160000210000001398000017570000222600001000000031900000194400002546000017080000127600001807000026340000095600002202000023310000253600001483000028700000302200003064000015000000358600002660000031200000268700003164000012850000280800002028000032320000424300005122000026870000410200003518000046040000274800003856000034860000389200003281000040360000235800003482000023160000377800003988000035880000300100005022000032830000370600002662000041600000366900005128000030320000479600002813000048380000232000004564000058110000535400004560000048840000573200006024000045520000696800006236000062500000539400006284000052090000448200004161000063720000515600007394000033750000628600006071000063100000245600007404000048880000648400005147000054640000343800007388000067790000655000006479000067180000624100006088000053520000785400006812000068800000672700009064000056400000662200007102000085300000671900007436000064510000835000007332000079600000850300008924000050740000801000008739000094880000693900008706000061660001023400007652000084920000761300009160000079530001053800007187000094940000736800009696000085940000906000008243000106460000704700009268000068890000906200006883000112060000628300010330000072710000875000007188000095720000720400010862000078920000894400008743000101460000970100009982000074650000996400007992000088960000774900010898000090920000994200008629000115940000694000008740000081360001108000008338000092640000845800012686000090790001038200010632000111560000777600009636000082150001103200007912000103060000988100011934000103390000828600009333000117000000749200009780000119490001289400008948000104680001071700012804000084610001265600010581000118280001030900010738000079430001212400008555000110100001104700010708000095240001072200008944000138580000902700011068000100790001283200013475000103120000863200011022000075790001017000009164000106400001010600011736000080500001313600007906000103740000828100012010000102970000934000009132000118040000925100010440000100020001070600007697000102680000819200012340000086540001160600008759000123960001104600009446000086510001214600008440000113920001161400011968000096020001081800011073000102240000967300011480000090810001360200010897000101100000763000010982000102150001031000010177000101360000887200010414000081380001029200009063000115500000882000012442000126430000953000009026000090240000815400008750000089920001058200008833000102760000824100011644000072500000832400007204000101980000991400006042000079620001111800008454000098500000931100008768000073260000951000007308000087820000729000008716000065490001142200009350000057440000543100007010000055200000707200007959000078340000564800007404000065510000757800006639000081360000593100007900000069120000555000004869000090180000582200005460000073540000724800005544000078900000585000008294000065850000670600005061000076220000992100004896000051960000528400005422000040400000632300005306000061290000723600004077000073860000420700005548000054960000819400005415000040320000294100007546000043570000540000004707000068840000381500005588000036810000468000004691000071280000471200005760000056250000344400002460000043400000217200003268000015660000363200002697000035260000242700002742000017320000350800002345000046860000365400002300000016340000560000000995000018160000148700002954000025630000390600001214000025420000175700002164000016940000361400004869000004839999979700002354000023270000126200001116000034980000266400000816000007750000339000001648000007540000058400001634000013900000020999999328000034020000202900001290000007670000238600000303000016340000049400001174000012400000131000000062000030440000157999999289999994570000027199999074999996079999985900000827999997630000064799998608000009200000217700001442000007110000143800001696999990659999897200000749999989380000007399999029999996439999927000000631999990000000055400001377999999179999948900000336000019479999991599998679999994979999989299998765999989349999957200000768000007459999891399999453999985349999972399999369999997460000182399997953999988219999953600000185999994919999958700000106000007189999896799999365000002940000000899999681999980810000028000000016.

看起来二者差得很多,这个算法不对了,少了很多。
#223
ysr28572021-03-20 02:33
398300005686000056410000210700002291000025680000358000001910000041060000324800003188000043080000280600003186000022910000348800003584000050460000465500002886000032090000376400001754000019420000341600002704000035330000244000001195000025340000221000003668000047560000333000004230000017500000169400002018000022060000280800002534000027320000291500001552000028750000209000000479000031580000288500003458000031820000164200001700000017300000361300002096000032620000356800003335000015500000200400002406000018300000206200003722000043040000346500002080000022430000129400001763000023140000227900001448000019020000062000000564000012140000225100002208000013840000220000002465000017260000134600001924000018540000192000001353000021960000214200000802000005290000136000002521000017300000272400000408000028799999707799998300999977839999789999998601999982429999777399998999999968099999805599997453999982919999872399998192999973659999904399997797999976689999746399998516999971299999697799996935999984999999641399997339999968799999731299996835999987149999719199997971999967679999575699994877999973129999589799996481999953959999725199996143999965139999610799996718999959639999764199996517999976839999622199996011999964119999699899994977999967169999629399997337999958399999633099994871999969679999520399997186999951619999767999995435999941889999464599995439999951159999426799993975999954479999303199993763999937499999460599993715999947909999551799995838999936279999484399992605999966249999371399993928999936899999754399992595999951119999351599994852999945359999656199992611999932209999344999993520999932819999375899993911999946479999214599993187999931199999327299990935999943599999337799992897999914699999328099992563999935489999164999992667999920399999149699991075999949259999198999991260999905119999306099991293999938339998976599992347999915079999238699990839999920469998946199992812999905059999263199990303999914059999093999991756999893539999295299990731999931109999093799993116999887939999371699989669999927289999124999992811999904279999279599989137999921079999105599991256999898539999029899990017999925349999003599992007999911039999225099989101999909079999005799991370999884059999305999991259999918639998891999991661999907359999154199987313999909209998961799989367999888439999222399990363999917849998896799992087999896939999011899988065999896609999171399990666999882999999250799990219999880509998710599991051999895319998928299987195999915389998734399989418999881719998969099989261999920569998787599991444999889899998895299989291999904759998927799991055999861419999097299988931999899209998716799986524999896879999136799988977999924209998982999990835999893599998989399988263999919499998686399992093999896259999171899987989999897029999065999990867999881959999074899989559999899979998929399992302999897319999180799987659999913459998839399991240999876039998895399990553999913489998785399991559999886079998838599988031999903979998918199988926999897759999032699988519999909189998639799989102999898899999236999989017999897849998968999989822999898639999112799989585999918619998970799990936999884499999117999987557999873569999046999990973999909759999184599991249999910079998941799991166999897239999175899988355999927499999167599992795999898019999008599993957999920379998888199991545999901499999068899991231999926739999048999992691999912179999270999991283999934509998857799990649999942559999456899992989999944799999292799992040999921659999435199992595999934489999242199993360999918639999406899992099999930879999444999995130999909819999417799994539999926459999275199994455999921099999414999991705999934149999329399994938999923779999007899995103999948039999471599994577999959599999367699994693999938709999276399995922999926139999579299994451999945039999180599994584999959679999705899992453999956429999459999995292999931159999618499994411999963189999531999995308999928719999528799994239999943749999655599997539999956599999782799996731999984339999636799997302999964739999757299997257999982679999649199997654999953139999634599997699999983659999439999999004999981839999851299997045999974369999609399998785999974579999824299997835999983059999638599995130999995160000020299997645999976729999873799998883999965019999733599999183999992249999660999998351999992459999941599998365999986099999979000000671999965979999797099998709999992329999761399999696999983659999950599998825999987599999868999999937999969559999842000000710000005429999972800000925000003920000014099999172000002369999935200001391999990799999782299998557999992889999856199998303000009340000102799999250000010619999992600000970000003560000072999999368000009999999944599998622000000820000051099999663999980520000008400001320000005020000010700001234000010650000042799999231999992540000108600000546000014650000027600000630000002539999817600002046000011780000046399999814000005080000041299999893999992810000103200000634999997059999999100000318000019189999971999999984.
这个有4884位,是减数和被减数反过来减的,看起来被减数(正确值)是小的,错误结果反而是大的。上面的差值是4888位,最高位是9就是比被减数还大,是错误的,我的减法是可以这样算的,最高位算起的,最高位前面没有数字了,其实前面应该剩下个-1,哈哈哈!该程序的缺点,不判断两个数的大小,应该先判断,再有大的减小的,被减数小的话输出负值,并反过来算就对了,仅从乘法结果的末尾看,错误的数字是3017585,正确的数字是3017601,似乎仅仅差末尾3位,其实前面有很多数字是不对的,而错误结果其实是大于实际值的。

[此贴子已经被作者于2021-3-20 02:41编辑过]

#224
ysr28572021-03-20 02:50
回复 219楼 ysr2857
11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111(329位,329个1)*101=11111111111111111111111111111111111111111111111122222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222222211有377位,用时0.2773438秒(331位是正确的,多了46个1)。

[此贴子已经被作者于2021-3-20 08:10编辑过]

#225
ysr28572021-03-20 08:59
回复 220楼 ysr2857
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801*
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801=
2678145490787694710138406683675886762424440548647327525594133873038347266950777818028529804877891353347244255046176220880989519574806598935727647635506939520211209794328712328126947740602255036264392628020291100698432900022333877728824270241063030019536831205264726059774673235680796770108334187808344470141093691232926021244583649747591446066921535333854157441330339217364515328375889937313870826987520723914810358707312468857074455945610038118763873992681688857200178452843740327143990247797893489008808544535536081089994800692174759199578596435124153437689121057209523619989593900355037400039597165241729693472001589594642879166693443994939359639600558001937547209387175085119128575833396037478944824322315197771750730768383267287661855880237549141571520374996029107650341071074081501632143441365461865431362023790463469688071768208320226561675630348708531708110373889241713511809029065048200924851629507265095151843687852114948736130517024578482059771284515915597919026074110811882700307150650858080695566672584075215926450360584738705106755945308199980660478183563586945902705730231409948938478910176292179410952310592864745025373902249844607078729230098512959498522851990040833671698873183076996740726479481352429756295966452788332789259316653805673821716832204368483794501474641036177256005810416507649770210480747056764697918800240201155395628561684853684747063434500664449114760179367086926249813006056735202795763742271472136500817313178050955623517148960973128433455798444839070215800699075256371341531892841721456473301085595261371522078416420399702683504171019191363372883472415693921509069484448792009627325245658854979159002549542769741504596589556474585723101403486046952706847309188488390899096649210853675228464611999630360164703837131620319658277117300208326944026347808645954842782309633205645471959842390075986572806483755223497552549948718545978420793425036666212191832327909389117021539426917904222971515424022606157676379417252939026404363841301595348953340657745965591468370831371449860774296757556463049237248472613472436666799615694672489600751763956185893123579218797539971253828850163437053164723845196089466298000486042246621634263064752906475198879616484926366053597071510886820878425907736453843197228282179943365206039514850477377542684361730162273246709577442085159313947668552462343596819299335060863266863059421286080919061657175757802930378698062290163092494909661982639303946271889619023417245433500782685534406291391527022657608608130680134939380126048353657648559735671562230714451258764762350451448379438849319710473631625533527602085050858633346936315115309333355986556546113134787213610042970405680162084678021281774169131725296977361816657904233850711837826724976507876061043779177845550646612327663283839673950405472039432309339110648301347672597370034346896334064135099613033528785924976781865447506814375627647103020761819104412269362847848884053177378762432543285984193091289854949394023586451139393716370633759317698908834326333339634557238526607966375935960004339535161203546369910853171524516945554862019134684985868547068709986010719120259421723270478586992153989283736650948010894951434857207445141886625290777550599700738909777829412358941157674866550887608199469723859806486384262574182811908513849905040209776132986875560077482527819093584150609347560543627976011009349905362597935257895287412087233810106693141683912683308201407373637490835862452911394718399632093441745957478079754723679119343225931665785380948807114301164623717144211285944154289093317610519159281033583963015810556464180819928345256832572962092994993950655913067768151113345566231088759030148164710287289335782462899525700500822021472132532771242198844498579102733028256523810973405350508253183399668290339844052874956694050028526577775764032598023622192221226501334606994447870277619118208162133562541678250491647671042612088902952091163094215645902682086024337098910110924115381788866213335441814530141911754446270296630426675020592640816713810936850961517475097707179713115856513919631998747192606018612535436009162735908155778165736923393260822217415131632296810207091918499370220533980666393617256227781299273913099896641458499949922475383775878771011361417556799406151773618626138749998464514570482965286184387350245762317271666329142667987131139265167425606863654107927682419958167046956962340419295394058625063862272314570914511355913547470055072878835349142049813368019960713974852351833144227544851625677753419141348585495260230041111323576432417502998832485027071744397105338790364666312325483218209150368759120749671419554589928540715813531144241705501211397506662448276056294585639532800634727428900861538486753011006379264618338782036690340859441153926551954112364946638768223012718907190897165613382555036872673785444132692292217184974818914501886689736449912131900762592363447945036085692999163815947845753538999001633767986447907729462453017601有4888位,用时9.912109秒(这个看上去是对的,用时和手工计算差不多,还略多一点?)
#226
ysr28572021-03-20 09:14
回复 215楼 ysr2857
147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369147852369*36985214=5465465465465465465465465465465465465465465465465465465465465465465465465465465465465468351513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317513340317507871966有487位,用时0.5390625秒(末尾数字是与实际相同的,最高位咋又多了好多位?)

看看这样不行,无法调整了,把一位一组的程序再优化一下吧。
#227
ysr28572021-03-20 09:21
回复 145楼 xianfajushi
999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999(270位)*9=88888888888888888888888888888888888888888888888888888888888888999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999991有332位,用时0.5秒(不对了,多了很多8字,应该是271位)
#228
ysr28572021-03-20 09:26
修改了一下程序,这回可能对了,程序速度和模仿手工计算的相似,还能提高,希望老师能优化一下程序,前面的一位一组是对的,速度太慢能否优化?这个待优化的快速程序代码如下:

Private Sub Command1_Click()
  Dim xr() As String, a As String
  a = Trim(Text1)
  b = Trim(Text3)
  ts = Timer
  x = Len(a) \ 4: Y = Len(b) \ 4
  If Val(4 * x) = Len(a) Then
  a = a
  ElseIf Val(4 * Y) = Len(b) Then
  b = b
  Else
  a = String(Val(x * 4 + 4 - Len(a)), "0") & a
  b = String(Val(Y * 4 + 4 - Len(b)), "0") & b
  x = x + 1: Y = Y + 1
  End If
  
  
  sb1 = x + Y
  sb2 = Log(sb1) / Log(2)
  If InStr(sb2, ".") = 0 Then
  sb2 = sb2
  Else
  sb2 = Int(sb2) + 1
  End If
  sb = 2 ^ sb2
  Print sb
  

  a = String(Val(sb) * 4 - Len(a), "0") & a
  b = String(Val(sb) * 4 - Len(b), "0") & b
  a = dxcx0(Trim(a), Val(sb)): b = dxcx0(Trim(b), Val(sb))
  Print a
  ReDim xr(0 To (Len(a) - 4) \ 4): ReDim yr(0 To (Len(b) - 4) \ 4): ReDim zr(0 To (Len(b) - 4) \ 4)
  If Len(a) = 4 Then
  xr(0) = a: yr(0) = b
  Else
  For i1 = 0 To (Len(a) - 4) \ 4
  xr(i1) = Mid(a, (i1 + 1) * 4 - 3, 4)
  yr(i1) = Mid(b, (i1 + 1) * 4 - 3, 4)

     Next
     End If
  
  Dim xi(): Dim yi(): Dim zi()
  n = Len(a) \ 4 '求数组大小,其值必须是2的幂
m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > n
  n = l / 2
  ReDim xi(n - 1): ReDim yi(n - 1): ReDim zi(n - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     xr(p) = Format(Val(xr(p)), "0.000000"): xi(p) = Format(Val(xi(p)), "0.000000")
     yr(p) = Format(Val(yr(p)), "0.000000"): yi(p) = Format(Val(yi(p)), "0.000000")
     Print xr(p), xr(q)
      p = p + le
  Loop Until p > n - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For I = 0 To n - 1 '仅输出模
   zr(I) = xr(I) * yr(I) - xi(I) * yi(I): zi(I) = xr(I) * yi(I) + xi(I) * yr(I)
      zr(I) = Format(Val(zr(I)), "0.000000"): zi(I) = Format(Val(zi(I)), "0.000000")

      s = s & "/" & zr(I)
      s1 = s1 & "/" & zi(I)
      Next
     s2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)), Trim(sb1))
     
      Text2 = s2 & "有" & Len(s2) & "位,用时" & Timer - ts & "秒"
  End Sub

  Private Sub Command2_Click()
  Text1 = ""
  Text2 = ""
  Text3 = ""
  Form1.Cls
  End Sub

Private Function qdqd0(sa As String) As String
  a = sa
  Do While Left(a, 1) = "0"
  a = Mid(a, 2)
  Loop
  If a = "" Then
  a = 0
  Else
  a = a
  End If
  qdqd0 = a
  End Function


  Private Function nifft(sa As String, sb As String, sb1 As String) As String
  
  Dim xi(): Dim yi(): Dim zi()
  Dim xr(), yr()
  Dim zr() As String
  
  s2 = Split(sa, "/")
  s3 = Split(sb, "/")
      J = UBound(s2)
      n = J
     For k = 1 To J
         n1 = n1 + 1
          ReDim Preserve xr(0 To n1 - 1)
          ReDim Preserve yr(0 To n1 - 1)
         xr(n1 - 1) = s2(n1): yr(n1 - 1) = s3(n1)
         xr(n1 - 1) = Format(Val(xr(n1 - 1)), "0.000000"): yr(n1 - 1) = Format(Val(yr(n1 - 1)), "0.000000")

       Next
     

  ReDim zr(0 To J - 1)

  m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > n
  n = l / 2
  ReDim xi(n - 1): ReDim yi(n - 1): ReDim zi(n - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = -1 * pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     xr(p) = Format(Val(xr(p)), "0.000000"): xi(p) = Format(Val(xi(p)), "0.000000")
     yr(p) = Format(Val(yr(p)), "0.000000"): yi(p) = Format(Val(yi(p)), "0.000000")
      p = p + le
  Loop Until p > n - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For I = 0 To n - 1 '仅输出模
zr(I) = (xr(I) - yi(I)) / n
      zr(I) = Format(Val(zr(I) + 0.5), "0.000000")
     If InStr(zr(I), ".") = 0 Then
     s1 = zr(I)
     Else
     s1 = Left(zr(I), InStr(zr(I), ".") - 1)
      End If
      s = "/" & s1 & s
      zr(I) = s1
      Next
      For i1 = 1 To Val(J - sb1 + 1)
      zr(sb1 + i1 - 2) = 0
      Next
      
     
     
      For i1 = 0 To n - 1
      If zr(i1) < 0 Then
      zr(i1) = "00000000"
      Else
      zr(i1) = zr(i1)
      End If
      s5 = s5 & "/" & zr(i1)
      
      If i1 = 0 Then
      If Len(zr(i1)) < 4 Then
      zr(i1) = String(4 - Len(zr(i1)), "0") & zr(i1)
      Else
      zr(i1) = zr(i1)
      End If
      s6 = Val(Left(zr(i1), Len(zr(i1)) - 4))
      If Len(s6) < 4 Then
      s6 = String(4 - Len(s6), "0") & s6
      Else
      s6 = s6
      End If
      s8 = Right(zr(i1), 4)
      ElseIf Val(zr(i1)) >= 0 Then
      s7 = MPC1(Trim(zr(i1)), Trim(s6))
      s10 = Right(s7, 4)
      s11 = s10 & s11
      If Len(s7) < 4 Then
      s7 = String(4 - Len(s7), "0") & s7
      ElseIf Len(s7) = 4 Then
      s6 = "00000000"
      Else
      s7 = s7
      s6 = Val(Left(s7, Len(s7) - 4))
      End If
      Else
      s6 = s6
      End If
     
      Next
      s9 = s6 & s11 & s8
     
  nifft = qdqd0(Trim(s9))

  End Function

  Private Function dxcx0(sa As String, sb As String) As String

  Dim x_() As String, a As String
    a = Trim(sa)
    ReDim x_(1 To sb)
    For i1 = 1 To sb
    x_(i1) = Mid(a, (sb - i1 + 1) * 4 - 3, 4)
    If Len(x_(i1)) < 4 Then
    x_(i1) = String(4 - Len(x_(i1)), "0") & x_(i1)
    Else
    x_(i1) = x_(i1)
    End If
   
      Next
    Dim n As Integer, I As Long, J As Long, mn As Long, lh As Long, t As Double, k As Long
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
    s = s & x_(J + 1)
    Next
    dxcx0 = x_(1) & x_(1 + sb / 2) & s
   
   

  End Function

  Private Function dxcx1(sa As String) As String

  Dim x_() As Double, a As String
    a = Trim(sa)
     

  s2 = Split(sa, "/")
  s3 = Split(sb, "/")
      J = UBound(s2)
      sb = J
     
       ReDim x_(1 To sb)
     For k = 1 To J
         n1 = n1 + 1
          ReDim Preserve x_(1 To n1)
        
         x_(n1) = Format(Val(s2(n1)), "0.000000")
       Next
    Dim n As Integer, I As Long, mn As Long, lh As Long, t As Double
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
x_(J + 1) = Format(Val(x_(J + 1)), "0.000000")
    s = s & "/" & x_(J + 1)
    Next
    x_(1) = Format(Val(x_(1)), "0.000000"): x_(1 + sb / 2) = Format(Val(x_(1 + sb / 2)), "0.000000")
    dxcx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & s
   
    End Function

Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
Dim x, Y '两数长度

If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
d3 = D1
Else
D4 = D2
d3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(d3): Y = Len(D4)
Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
ReDim a(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim E1(1 To x)
Dim I, J, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
B1(J) = Mid$(D4, J, 1) '每位数
For I = x To 1 Step -1  'D1
   a(I) = Mid$(d3, I, 1) '每位数
   C1(I) = a(I) + B1(I) + JW '计算jia
   JW = C1(I) \ 10
   E1(I) = C1(I) Mod 10
  Next
  Next
  For r = 1 To x
  If JW = 0 Then
  MPC1 = MPC1 & E1(r)
  Else
  jc = jc & E1(r)
  MPC1 = JW & jc
  End If
  Next
  
End Function


[此贴子已经被作者于2021-3-20 10:24编辑过]

#229
ysr28572021-03-20 10:27
999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999(270位)*9=8999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999991有271位,用时0.8242188秒(哈哈哈这回可能对了)
#230
ysr28572021-03-20 11:23
回复 211楼 ysr2857
111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*111111111=12345678999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999987654321有221位,用时0.3984375秒(结果是对的,速度提高了一点,可能还有提升空间,希望帮助优化,谢谢各位老师!)
#231
ysr28572021-03-20 14:41
优化的程序,一位一组的,没有完成速度提高不明显,暂时发一下:(有空在接着弄吧,有提升空间)

Dim l As Long, le As Long, le1 As Long, n As Long, r As Long, p As Long, q As Long, m As Byte
  Dim wr As Double, w1 As Double, wlr As Double, wl1 As Double, tr As Double, t1 As Double
  Dim pi As Double, t As Double, tr1 As Double

Private Sub Command1_Click()
  Dim xr() As Double, a As String
  a = Trim(Text1)
  b = Trim(Text3)
  ts = Timer
  
  Text2 = js & "有" & Len(js) & "位,用时" & Timer - ts & "秒"
  sb1 = Len(a) + Len(b)
  sb2 = Log(sb1) / Log(2)
  If InStr(sb2, ".") = 0 Then
  sb2 = sb2
  Else
  sb2 = Int(sb2) + 1
  End If
  sb = 2 ^ sb2
  Print sb
  If Len(a) = Len(b) And 2 ^ (Int(Log(Len(a)) / Log(2))) = Len(a) Then
    a = String(Val(sb) - Len(a), "0") & a
  b = String(Val(sb) - Len(b), "0") & b
  ax = a: bx = b
  Else

  a = String(Val(sb) - Len(a), "0") & a
  b = String(Val(sb) - Len(b), "0") & b
  ax = a: bx = b
  End If
  Dim y_() As Double, x_() As Double
  ReDim x_(1 To sb): ReDim y_(1 To sb)
    For i1 = 1 To sb
    x_(i1) = Mid(ax, sb - i1 + 1, 1): y_(i1) = Mid(bx, sb - i1 + 1, 1)
      Next
    Dim n As Integer, I As Long, J As Long, mn As Long, lh As Long, t As Double, k As Long
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
    s = s & x_(J + 1)
    s1 = s1 & y_(J + 1)
    Next
    a = x_(1) & x_(1 + sb / 2) & s
    b = y_(1) & y_(1 + sb / 2) & s1
  
  ReDim xr(0 To Len(a) - 1): ReDim yr(0 To Len(b) - 1): ReDim zr(0 To Len(b) - 1)
  For i1 = 0 To Len(a) - 1
  xr(i1) = Mid(a, i1 + 1, 1)
  yr(i1) = Mid(b, i1 + 1, 1)

     Next
  
  Dim xi(): Dim yi(): Dim zi()
  n = Len(a) '求数组大小,其值必须是2的幂
m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > n
  n = l / 2
  ReDim xi(n - 1): ReDim yi(n - 1): ReDim zi(n - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     
      p = p + le
  Loop Until p > n - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For I = 0 To n - 1 '仅输出模
   zr(I) = xr(I) * yr(I) - xi(I) * yi(I): zi(I) = xr(I) * yi(I) + xi(I) * yr(I)
      

      's = s & "/" & zr(I)
      's1 = s1 & "/" & zi(I)
      Next
      
       J = sb
     
       ReDim x_(1 To sb): ReDim y_(1 To sb)
     For k = 1 To J
         n1 = n1 + 1
          ReDim Preserve x_(1 To n1)
        
         x_(n1) = zr(n1 - 1): y_(n1) = zi(n1 - 1)
       Next
   
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
    js = js & "/" & x_(J + 1)
    js1 = js1 & "/" & y_(J + 1)
    Next
    sx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & js
    sy1 = "/" & y_(1) & "/" & y_(1 + sb / 2) & js1
   
   
   
   
   
      
      
     's2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)), Trim(sb1))
     s3 = nifft(Trim(sx1), Trim(sy1), Trim(sb1))
      Text2 = s3 & "有" & Len(s3) & "位,用时" & Timer - ts & "秒"
  End Sub

  Private Sub Command2_Click()
  Text1 = ""
  Text2 = ""
  Text3 = ""
  Form1.Cls
  End Sub

Private Function qdqd0(sa As String) As String
  a = sa
  Do While Left(a, 1) = "0"
  a = Mid(a, 2)
  Loop
  If a = "" Then
  a = 0
  Else
  a = a
  End If
  qdqd0 = a
  End Function

  Private Function nifft(sa As String, sb As String, sb1 As String) As String
  
  Dim xi(): Dim yi(): Dim zi()
  Dim xr(), yr(), zr()
  s2 = Split(sa, "/")
  s3 = Split(sb, "/")
      J = UBound(s2)
      n = J
     For k = 1 To J
         n1 = n1 + 1
          ReDim Preserve xr(0 To n1 - 1)
          ReDim Preserve yr(0 To n1 - 1)
         xr(n1 - 1) = s2(n1): yr(n1 - 1) = s3(n1)
       Next
     

  ReDim zr(0 To J - 1)

  m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > n
  n = l / 2
  ReDim xi(n - 1): ReDim yi(n - 1): ReDim zi(n - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = -1 * pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     
      p = p + le
  Loop Until p > n - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For I = 0 To n - 1 '仅输出模
zr(I) = (xr(I) - yi(I)) / n
      
     
      s1 = Int(Val(zr(I) + 0.5))
      s = "/" & s1 & s
      zr(I) = s1
      Next
      For i1 = 1 To Val(J - sb1 + 1)
      zr(sb1 + i1 - 2) = 0
      Next
      
     
     
      For i1 = 0 To n - 1
      If zr(i1) < 0 Then
      zr(i1) = 0
      Else
      zr(i1) = zr(i1)
      End If
      
      s5 = "/" & Int(zr(i1)) & s5
      If i1 = 0 Then
      s6 = Int(zr(i1)) \ 10
      s8 = Int(zr(i1)) Mod 10
      ElseIf Val(zr(i1)) >= 0 Then
      s7 = Int(zr(i1)) + Val(s6)
      s10 = Val(s7) Mod 10
      s11 = s10 & s11
      s6 = Val(s7) \ 10
      Else
      s6 = Val(s6)
      End If
     
      Next
      s9 = s6 & s11 & s8
     
  nifft = qdqd0(Trim(s9))

  End Function

  Private Function dxcx0(sa As String, sb As String) As String

  Dim x_() As Double, a As String
    a = Trim(sa)
    ReDim x_(1 To sb)
    For i1 = 1 To sb
    x_(i1) = Mid(a, sb - i1 + 1, 1)
      Next
    Dim n As Integer, I As Long, J As Long, mn As Long, lh As Long, t As Double, k As Long
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
    s = s & x_(J + 1)
    Next
    dxcx0 = x_(1) & x_(1 + sb / 2) & s
   

  End Function

Public Function MbC(D1 As String, D2 As String) As String '乘法
Dim x, Y '两数长度
x = Len(D1): Y = Len(D2)
Dim a() As Integer
ReDim a(1 To x + Y, 1 To Y)
Dim I, J, C1, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
C2 = Mid$(D2, J, 1) '每位数
For I = x To 1 Step -1 'D1
  C1 = Mid$(D1, I, 1) '每位数
  CJ = C1 * C2 + JW '计算乘积
  c = I + J: r = Y + 1 - J
  a(c, r) = CJ Mod 10 '本位
  JW = CJ \ 10 '进位
Next
a(c - 1, r) = JW
Next
Dim b() As Integer
ReDim b(1 To x + Y)
JW = 0
For I = x + Y To 1 Step -1
Bit = JW
For J = 1 To Y
  Bit = Bit + a(I, J)
Next
b(I) = Bit Mod 10
JW = Bit \ 10
Next
If b(1) > 0 Then
MbC = MbC & b(1)
Else
MbC = MbC
End If
For I = 2 To x + Y
MbC = MbC & b(I)
Next
End Function

  Private Function dxcx1(sa As String) As String

  Dim x_() As Double, a As String
    a = Trim(sa)
     

  s2 = Split(sa, "/")
  s3 = Split(sb, "/")
      J = UBound(s2)
      sb = J
     
       ReDim x_(1 To sb)
     For k = 1 To J
         n1 = n1 + 1
          ReDim Preserve x_(1 To n1)
        
         x_(n1) = s2(n1)
       Next
    Dim n As Integer, I As Long, mn As Long, lh As Long, t As Double
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
    s = s & "/" & x_(J + 1)
    Next
    dxcx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & s
   
    End Function


[此贴子已经被作者于2021-3-20 21:31编辑过]

#232
ysr28572021-03-20 19:23
回复 225楼 ysr2857
这是模仿手工计算的程序结果,看上去比傅立叶变换的程序还快?结果如下:
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801*
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801=
2678145490787694710138406683675886762424440548647327525594133873038347266950777818028529804877891353347244255046176220880989519574806598935727647635506939520211209794328712328126947740602255036264392628020291100698432900022333877728824270241063030019536831205264726059774673235680796770108334187808344470141093691232926021244583649747591446066921535333854157441330339217364515328375889937313870826987520723914810358707312468857074455945610038118763873992681688857200178452843740327143990247797893489008808544535536081089994800692174759199578596435124153437689121057209523619989593900355037400039597165241729693472001589594642879166693443994939359639600558001937547209387175085119128575833396037478944824322315197771750730768383267287661855880237549141571520374996029107650341071074081501632143441365461865431362023790463469688071768208320226561675630348708531708110373889241713511809029065048200924851629507265095151843687852114948736130517024578482059771284515915597919026074110811882700307150650858080695566672584075215926450360584738705106755945308199980660478183563586945902705730231409948938478910176292179410952310592864745025373902249844607078729230098512959498522851990040833671698873183076996740726479481352429756295966452788332789259316653805673821716832204368483794501474641036177256005810416507649770210480747056764697918800240201155395628561684853684747063434500664449114760179367086926249813006056735202795763742271472136500817313178050955623517148960973128433455798444839070215800699075256371341531892841721456473301085595261371522078416420399702683504171019191363372883472415693921509069484448792009627325245658854979159002549542769741504596589556474585723101403486046952706847309188488390899096649210853675228464611999630360164703837131620319658277117300208326944026347808645954842782309633205645471959842390075986572806483755223497552549948718545978420793425036666212191832327909389117021539426917904222971515424022606157676379417252939026404363841301595348953340657745965591468370831371449860774296757556463049237248472613472436666799615694672489600751763956185893123579218797539971253828850163437053164723845196089466298000486042246621634263064752906475198879616484926366053597071510886820878425907736453843197228282179943365206039514850477377542684361730162273246709577442085159313947668552462343596819299335060863266863059421286080919061657175757802930378698062290163092494909661982639303946271889619023417245433500782685534406291391527022657608608130680134939380126048353657648559735671562230714451258764762350451448379438849319710473631625533527602085050858633346936315115309333355986556546113134787213610042970405680162084678021281774169131725296977361816657904233850711837826724976507876061043779177845550646612327663283839673950405472039432309339110648301347672597370034346896334064135099613033528785924976781865447506814375627647103020761819104412269362847848884053177378762432543285984193091289854949394023586451139393716370633759317698908834326333339634557238526607966375935960004339535161203546369910853171524516945554862019134684985868547068709986010719120259421723270478586992153989283736650948010894951434857207445141886625290777550599700738909777829412358941157674866550887608199469723859806486384262574182811908513849905040209776132986875560077482527819093584150609347560543627976011009349905362597935257895287412087233810106693141683912683308201407373637490835862452911394718399632093441745957478079754723679119343225931665785380948807114301164623717144211285944154289093317610519159281033583963015810556464180819928345256832572962092994993950655913067768151113345566231088759030148164710287289335782462899525700500822021472132532771242198844498579102733028256523810973405350508253183399668290339844052874956694050028526577775764032598023622192221226501334606994447870277619118208162133562541678250491647671042612088902952091163094215645902682086024337098910110924115381788866213335441814530141911754446270296630426675020592640816713810936850961517475097707179713115856513919631998747192606018612535436009162735908155778165736923393260822217415131632296810207091918499370220533980666393617256227781299273913099896641458499949922475383775878771011361417556799406151773618626138749998464514570482965286184387350245762317271666329142667987131139265167425606863654107927682419958167046956962340419295394058625063862272314570914511355913547470055072878835349142049813368019960713974852351833144227544851625677753419141348585495260230041111323576432417502998832485027071744397105338790364666312325483218209150368759120749671419554589928540715813531144241705501211397506662448276056294585639532800634727428900861538486753011006379264618338782036690340859441153926551954112364946638768223012718907190897165613382555036872673785444132692292217184974818914501886689736449912131900762592363447945036085692999163815947845753538999001633767986447907729462453017601有4888位,用时3.929688秒
#233
ysr28572021-03-20 22:27
回复 230楼 ysr2857
111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*111111111=12345678999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999987654321有221位,用时0.2578125秒(经过优化速度略有提高,可能还有提升空间)
#234
ysr28572021-03-20 23:22
111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*111111111=12345678999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999987654321有221位,用时0.0859375秒(这个快,是4位一组的程序,还有可以优化的空间)
#235
ysr28572021-03-20 23:52
回复 227楼 ysr2857
999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999*9=8999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999991有271位,用时0.28125秒(这个是对的,速度还可以,还有提升空间,是4位一组的程序)
#236
ysr28572021-03-20 23:55
4位一组的程序重发如下,是修改好的,还有提升空间,希望老师指点,谢谢!代码如下:

Private Sub Command1_Click()
  Dim xr() As String, a As String
  a = Trim(Text1)
  b = Trim(Text3)
  ts = Timer
  x = Len(a) \ 4: Y = Len(b) \ 4
  If Val(4 * x) = Len(a) Then
  a = a
  ElseIf Val(4 * Y) = Len(b) Then
  b = b
  Else
  a = String(Val(x * 4 + 4 - Len(a)), "0") & a
  b = String(Val(Y * 4 + 4 - Len(b)), "0") & b
  x = x + 1: Y = Y + 1
  End If
  
  
  sb1 = x + Y
  sb2 = Log(sb1) / Log(2)
  If InStr(sb2, ".") = 0 Then
  sb2 = sb2
  Else
  sb2 = Int(sb2) + 1
  End If
  sb = 2 ^ sb2
  Print sb
  

  a = String(Val(sb) * 4 - Len(a), "0") & a
  b = String(Val(sb) * 4 - Len(b), "0") & b
  a = dxcx0(Trim(a), Val(sb)): b = dxcx0(Trim(b), Val(sb))
  Print a
  ReDim xr(0 To (Len(a) - 4) \ 4): ReDim yr(0 To (Len(b) - 4) \ 4): ReDim zr(0 To (Len(b) - 4) \ 4)
  If Len(a) = 4 Then
  xr(0) = a: yr(0) = b
  Else
  For i1 = 0 To (Len(a) - 4) \ 4
  xr(i1) = Mid(a, (i1 + 1) * 4 - 3, 4)
  yr(i1) = Mid(b, (i1 + 1) * 4 - 3, 4)

     Next
     End If
  
  Dim xi(): Dim yi(): Dim zi()
  n = Len(a) \ 4 '求数组大小,其值必须是2的幂
m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > n
  n = l / 2
  ReDim xi(n - 1): ReDim yi(n - 1): ReDim zi(n - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     xr(p) = Format(Val(xr(p)), "0.000000"): xi(p) = Format(Val(xi(p)), "0.000000")
     yr(p) = Format(Val(yr(p)), "0.000000"): yi(p) = Format(Val(yi(p)), "0.000000")
     Print xr(p), xr(q)
      p = p + le
  Loop Until p > n - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For I = 0 To n - 1 '仅输出模
   zr(I) = xr(I) * yr(I) - xi(I) * yi(I): zi(I) = xr(I) * yi(I) + xi(I) * yr(I)
      zr(I) = Format(Val(zr(I)), "0.000000"): zi(I) = Format(Val(zi(I)), "0.000000")

      s = s & "/" & zr(I)
      s1 = s1 & "/" & zi(I)
      Next
     s2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)), Trim(sb1))
     
      Text2 = s2 & "有" & Len(s2) & "位,用时" & Timer - ts & "秒"
  End Sub

  Private Sub Command2_Click()
  Text1 = ""
  Text2 = ""
  Text3 = ""
  Form1.Cls
  End Sub

Private Function qdqd0(sa As String) As String
  a = sa
  Do While Left(a, 1) = "0"
  a = Mid(a, 2)
  Loop
  If a = "" Then
  a = 0
  Else
  a = a
  End If
  qdqd0 = a
  End Function


  Private Function nifft(sa As String, sb As String, sb1 As String) As String
  
  Dim xi(): Dim yi(): Dim zi()
  Dim xr(), yr()
  Dim zr() As String
  
  s2 = Split(sa, "/")
  s3 = Split(sb, "/")
      J = UBound(s2)
      n = J
     For k = 1 To J
         n1 = n1 + 1
          ReDim Preserve xr(0 To n1 - 1)
          ReDim Preserve yr(0 To n1 - 1)
         xr(n1 - 1) = s2(n1): yr(n1 - 1) = s3(n1)
         xr(n1 - 1) = Format(Val(xr(n1 - 1)), "0.000000"): yr(n1 - 1) = Format(Val(yr(n1 - 1)), "0.000000")

       Next
     

  ReDim zr(0 To J - 1)

  m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > n
  n = l / 2
  ReDim xi(n - 1): ReDim yi(n - 1): ReDim zi(n - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = -1 * pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     xr(p) = Format(Val(xr(p)), "0.000000"): xi(p) = Format(Val(xi(p)), "0.000000")
     yr(p) = Format(Val(yr(p)), "0.000000"): yi(p) = Format(Val(yi(p)), "0.000000")
      p = p + le
  Loop Until p > n - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For I = 0 To n - 1 '仅输出模
zr(I) = (xr(I) - yi(I)) / n
      zr(I) = Format(Val(zr(I) + 0.5), "0.000000")
     If InStr(zr(I), ".") = 0 Then
     s1 = zr(I)
     Else
     s1 = Left(zr(I), InStr(zr(I), ".") - 1)
      End If
      s = "/" & s1 & s
      zr(I) = s1
      Next
      For i1 = 1 To Val(J - sb1 + 1)
      zr(sb1 + i1 - 2) = 0
      Next
      
     
     
      For i1 = 0 To n - 1
      If zr(i1) < 0 Then
      zr(i1) = "0000"
      ElseIf Len(zr(i1)) < 4 Then
      zr(i1) = String(4 - Len(zr(i1)), "0") & zr(i1)
      Else
      zr(i1) = zr(i1)
      End If
      
      s5 = s5 & "/" & zr(i1)
      
      If i1 = 0 Then
      
      s6 = Val(Left(zr(i1), Len(zr(i1)) - 4))
      If Len(s6) < 4 Then
      s6 = String(4 - Len(s6), "0") & s6
      Else
      s6 = s6
      End If
      s8 = Right(zr(i1), 4)
      ElseIf Val(zr(i1)) >= 0 Then
      s7 = MPC1(Trim(zr(i1)), Trim(s6))
      s10 = Right(s7, 4)
      s11 = s10 & s11
      If Len(s7) < 4 Then
      s7 = String(4 - Len(s7), "0") & s7
      ElseIf Len(s7) = 4 Then
      s6 = "0000"
      Else
      s7 = s7
      s6 = Val(Left(s7, Len(s7) - 4))
      End If
      Else
      s6 = s6
      End If
     
      Next
      s9 = s6 & s11 & s8
     
  nifft = qdqd0(Trim(s9))

  End Function

  Private Function dxcx0(sa As String, sb As String) As String

  Dim x_() As String, a As String
    a = Trim(sa)
    ReDim x_(1 To sb)
    For i1 = 1 To sb
    x_(i1) = Mid(a, (sb - i1 + 1) * 4 - 3, 4)
    If Len(x_(i1)) < 4 Then
    x_(i1) = String(4 - Len(x_(i1)), "0") & x_(i1)
    Else
    x_(i1) = x_(i1)
    End If
   
      Next
    Dim n As Integer, I As Long, J As Long, mn As Long, lh As Long, t As Double, k As Long
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
    s = s & x_(J + 1)
    Next
    dxcx0 = x_(1) & x_(1 + sb / 2) & s
   
   

  End Function

  Private Function dxcx1(sa As String) As String

  Dim x_() As Double, a As String
    a = Trim(sa)
     

  s2 = Split(sa, "/")
  s3 = Split(sb, "/")
      J = UBound(s2)
      sb = J
     
       ReDim x_(1 To sb)
     For k = 1 To J
         n1 = n1 + 1
          ReDim Preserve x_(1 To n1)
        
         x_(n1) = Format(Val(s2(n1)), "0.000000")
       Next
    Dim n As Integer, I As Long, mn As Long, lh As Long, t As Double
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
x_(J + 1) = Format(Val(x_(J + 1)), "0.000000")
    s = s & "/" & x_(J + 1)
    Next
    x_(1) = Format(Val(x_(1)), "0.000000"): x_(1 + sb / 2) = Format(Val(x_(1 + sb / 2)), "0.000000")
    dxcx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & s
   
    End Function

Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
Dim x, Y '两数长度

If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
d3 = D1
Else
D4 = D2
d3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(d3): Y = Len(D4)
Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
ReDim a(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim E1(1 To x)
Dim I, J, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
B1(J) = Mid$(D4, J, 1) '每位数
For I = x To 1 Step -1  'D1
   a(I) = Mid$(d3, I, 1) '每位数
   C1(I) = a(I) + B1(I) + JW '计算jia
   JW = C1(I) \ 10
   E1(I) = C1(I) Mod 10
  Next
  Next
  For r = 1 To x
  If JW = 0 Then
  MPC1 = MPC1 & E1(r)
  Else
  jc = jc & E1(r)
  MPC1 = JW & jc
  End If
  Next
  
End Function

#237
ysr28572021-03-20 23:59
回复 225楼 ysr2857
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801*
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801=
2678145490787694710138406683675886762424440548647327525594133873038347266950777818028529804877891353347244255046176220880989519574806598935727647635506939520211209794328712328126947740602255036264392628020291100698432900022333877728824270241063030019536831205264726059774673235680796770108334187808344470141093691232926021244583649747591446066921535333854157441330339217364515328375889937313870826987520723914810358707312468857074455945610038118763873992681688857200178452843740327143990247797893489008808544535536081089994800692174759199578596435124153437689121057209523619989593900355037400039597165241729693472001589594642879166693443994939359639600558001937547209387175085119128575833396037478944824322315197771750730768383267287661855880237549141571520374996029107650341071074081501632143441365461865431362023790463469688071768208320226561675630348708531708110373889241713511809029065048200924851629507265095151843687852114948736130517024578482059771284515915597919026074110811882700307150650858080695566672584075215926450360584738705106755945308199980660478183563586945902705730231409948938478910176292179410952310592864745025373902249844607078729230098512959498522851990040833671698873183076996740726479481352429756295966452788332789259316653805673821716832204368483794501474641036177256005810416507649770210480747056764697918800240201155395628561684853684747063434500664449114760179367086926249813006056735202795763742271472136500817313178050955623517148960973128433455798444839070215800699075256371341531892841721456473301085595261371522078416420399702683504171019191363372883472415693921509069484448792009627325245658854979159002549542769741504596589556474585723101403486046952706847309188488390899096649210853675228464611999630360164703837131620319658277117300208326944026347808645954842782309633205645471959842390075986572806483755223497552549948718545978420793425036666212191832327909389117021539426917904222971515424022606157676379417252939026404363841301595348953340657745965591468370831371449860774296757556463049237248472613472436666799615694672489600751763956185893123579218797539971253828850163437053164723845196089466298000486042246621634263064752906475198879616484926366053597071510886820878425907736453843197228282179943365206039514850477377542684361730162273246709577442085159313947668552462343596819299335060863266863059421286080919061657175757802930378698062290163092494909661982639303946271889619023417245433500782685534406291391527022657608608130680134939380126048353657648559735671562230714451258764762350451448379438849319710473631625533527602085050858633346936315115309333355986556546113134787213610042970405680162084678021281774169131725296977361816657904233850711837826724976507876061043779177845550646612327663283839673950405472039432309339110648301347672597370034346896334064135099613033528785924976781865447506814375627647103020761819104412269362847848884053177378762432543285984193091289854949394023586451139393716370633759317698908834326333339634557238526607966375935960004339535161203546369910853171524516945554862019134684985868547068709986010719120259421723270478586992153989283736650948010894951434857207445141886625290777550599700738909777829412358941157674866550887608199469723859806486384262574182811908513849905040209776132986875560077482527819093584150609347560543627976011009349905362597935257895287412087233810106693141683912683308201407373637490835862452911394718399632093441745957478079754723679119343225931665785380948807114301164623717144211285944154289093317610519159281033583963015810556464180819928345256832572962092994993950655913067768151113345566231088759030148164710287289335782462899525700500822021472132532771242198844498579102733028256523810973405350508253183399668290339844052874956694050028526577775764032598023622192221226501334606994447870277619118208162133562541678250491647671042612088902952091163094215645902682086024337098910110924115381788866213335441814530141911754446270296630426675020592640816713810936850961517475097707179713115856513919631998747192606018612535436009162735908155778165736923393260822217415131632296810207091918499370220533980666393617256227781299273913099896641458499949922475383775878771011361417556799406151773618626138749998464514570482965286184387350245762317271666329142667987131139265167425606863654107927682419958167046956962340419295394058625063862272314570914511355913547470055072878835349142049813368019960713974852351833144227544851625677753419141348585495260230041111323576432417502998832485027071744397105338790364666312325483218209150368759120749671419554589928540715813531144241705501211397506662448276056294585639532800634727428900861538486753011006379264618338782036690340859441153926551954112364946638768223012718907190897165613382555036872673785444132692292217184974818914501886689736449912131900762592363447945036085692999163815947845753538999001633767986447907729462453017601有4888位,用时3.351563秒(这是4位一组的算法,速度还可以,还有提升空间)
#238
ysr28572021-03-21 20:36
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801*
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801=
2678145490787694710138406683675886762424440548647327525594133873038347266950777818028529804877891353347244255046176220880989519574806598935727647635506939520211209794328712328126947740602255036264392628020291100698432900022333877728824270241063030019536831205264726059774673235680796770108334187808344470141093691232926021244583649747591446066921535333854157441330339217364515328375889937313870826987520723914810358707312468857074455945610038118763873992681688857200178452843740327143990247797893489008808544535536081089994800692174759199578596435124153437689121057209523619989593900355037400039597165241729693472001589594642879166693443994939359639600558001937547209387175085119128575833396037478944824322315197771750730768383267287661855880237549141571520374996029107650341071074081501632143441365461865431362023790463469688071768208320226561675630348708531708110373889241713511809029065048200924851629507265095151843687852114948736130517024578482059771284515915597919026074110811882700307150650858080695566672584075215926450360584738705106755945308199980660478183563586945902705730231409948938478910176292179410952310592864745025373902249844607078729230098512959498522851990040833671698873183076996740726479481352429756295966452788332789259316653805673821716832204368483794501474641036177256005810416507649770210480747056764697918800240201155395628561684853684747063434500664449114760179367086926249813006056735202795763742271472136500817313178050955623517148960973128433455798444839070215800699075256371341531892841721456473301085595261371522078416420399702683504171019191363372883472415693921509069484448792009627325245658854979159002549542769741504596589556474585723101403486046952706847309188488390899096649210853675228464611999630360164703837131620319658277117300208326944026347808645954842782309633205645471959842390075986572806483755223497552549948718545978420793425036666212191832327909389117021539426917904222971515424022606157676379417252939026404363841301595348953340657745965591468370831371449860774296757556463049237248472613472436666799615694672489600751763956185893123579218797539971253828850163437053164723845196089466298000486042246621634263064752906475198879616484926366053597071510886820878425907736453843197228282179943365206039514850477377542684361730162273246709577442085159313947668552462343596819299335060863266863059421286080919061657175757802930378698062290163092494909661982639303946271889619023417245433500782685534406291391527022657608608130680134939380126048353657648559735671562230714451258764762350451448379438849319710473631625533527602085050858633346936315115309333355986556546113134787213610042970405680162084678021281774169131725296977361816657904233850711837826724976507876061043779177845550646612327663283839673950405472039432309339110648301347672597370034346896334064135099613033528785924976781865447506814375627647103020761819104412269362847848884053177378762432543285984193091289854949394023586451139393716370633759317698908834326333339634557238526607966375935960004339535161203546369910853171524516945554862019134684985868547068709986010719120259421723270478586992153989283736650948010894951434857207445141886625290777550599700738909777829412358941157674866550887608199469723859806486384262574182811908513849905040209776132986875560077482527819093584150609347560543627976011009349905362597935257895287412087233810106693141683912683308201407373637490835862452911394718399632093441745957478079754723679119343225931665785380948807114301164623717144211285944154289093317610519159281033583963015810556464180819928345256832572962092994993950655913067768151113345566231088759030148164710287289335782462899525700500822021472132532771242198844498579102733028256523810973405350508253183399668290339844052874956694050028526577775764032598023622192221226501334606994447870277619118208162133562541678250491647671042612088902952091163094215645902682086024337098910110924115381788866213335441814530141911754446270296630426675020592640816713810936850961517475097707179713115856513919631998747192606018612535436009162735908155778165736923393260822217415131632296810207091918499370220533980666393617256227781299273913099896641458499949922475383775878771011361417556799406151773618626138749998464514570482965286184387350245762317271666329142667987131139265167425606863654107927682419958167046956962340419295394058625063862272314570914511355913547470055072878835349142049813368019960713974852351833144227544851625677753419141348585495260230041111323576432417502998832485027071744397105338790364666312325483218209150368759120749671419554589928540715813531144241705501211397506662448276056294585639532800634727428900861538486753011006379264618338782036690340859441153926551954112364946638768223012718907190897165613382555036872673785444132692292217184974818914501886689736449912131900762592363447945036085692999163815947845753538999001633767986447907729462453017601有4888位,用时3.695313秒(优化了一下程序,这是3位一组的算法,就是把3位数当做一位数,结果是可靠的,速度没有变,就是去掉了末尾的调用大数加法程序,不用大数加法程序直接加的,看来去掉大数加法也没有影响)
#239
ysr28572021-03-21 20:43
下面就是优化后的程序,这是3位一组的算法,就是把3位数当做一位数,结果是可靠的,速度没有变,要想提高速度,看来可以分段计算,比如50位一组,就是把50位的数当做一位数,这样就快了好像,还要结合大数的加减和乘法(模仿手工的乘法),明天试验一下吧,看看行不行,速度能否提高?
下面把这个优化的3位一组的程序发一下:

Dim l As Long, le As Long, le1 As Long, n As Long, r As Long, p As Long, q As Long, m As Byte
  Dim wr As Double, w1 As Double, wlr As Double, wl1 As Double, tr As Double, t1 As Double
  Dim pi As Double, t As Double, tr1 As Double

Private Sub Command1_Click()
  Dim xr() As Double, a As String
  a = Trim(Text1)
  b = Trim(Text3)
  ts = Timer
  
  x = Len(a) \ 3: Y = Len(b) \ 3
  If Val(3 * x) = Len(a) Then
  a = a
  ElseIf Val(3 * Y) = Len(b) Then
  b = b
  Else
  a = String(Val(x * 3 + 3 - Len(a)), "0") & a
  b = String(Val(Y * 3 + 3 - Len(b)), "0") & b
  x = x + 1: Y = Y + 1
  End If
  sb1 = x + Y
  sb2 = Log(sb1) / Log(2)
  If InStr(sb2, ".") = 0 Then
  sb2 = sb2
  Else
  sb2 = Int(sb2) + 1
  End If
  sb = 2 ^ sb2
  Print sb
  a = String(Val(sb) * 3 - Len(a), "0") & a
  b = String(Val(sb) * 3 - Len(b), "0") & b
  Print a
  
  
  
   ReDim x_(1 To sb): ReDim y_(1 To sb)
    For i1 = 1 To sb
    x_(i1) = Mid(a, (sb - i1 + 1) * 3 - 2, 3): y_(i1) = Mid(b, (sb - i1 + 1) * 3 - 2, 3)
    If Len(x_(i1)) < 3 Then
    x_(i1) = String(3 - Len(x_(i1)), "0") & x_(i1)
    ElseIf Len(y_(i1)) < 3 Then
    y_(i1) = String(3 - Len(y_(i1)), "0") & y_(i1)
    Else
    x_(i1) = x_(i1): y_(i1) = y_(i1)
    End If
   
      Next
    Dim n As Integer, I As Long, J As Long, mn As Long, lh As Long, t As Double, k As Long
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
    s = s & x_(J + 1)
    s1 = s1 & y_(J + 1)
    Next
    a = x_(1) & x_(1 + sb / 2) & s
    b = y_(1) & y_(1 + sb / 2) & s1
  
  ReDim xr(0 To (Len(a) - 3) \ 3): ReDim yr(0 To (Len(b) - 3) \ 3): ReDim zr(0 To (Len(b) - 3) \ 3)
  If Len(a) = 3 Then
  xr(0) = a: yr(0) = b
  Else
  For i1 = 0 To (Len(a) - 3) \ 3
  xr(i1) = Mid(a, (i1 + 1) * 3 - 2, 3)
  yr(i1) = Mid(b, (i1 + 1) * 3 - 2, 3)

     Next
     End If
  
  Dim xi(): Dim yi(): Dim zi()
  n = sb '求数组大小,其值必须是2的幂
m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > n
  n = l / 2
  ReDim xi(n - 1): ReDim yi(n - 1): ReDim zi(n - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     xr(p) = Format(Val(xr(p)), "0.000000"): xi(p) = Format(Val(xi(p)), "0.000000")
     yr(p) = Format(Val(yr(p)), "0.000000"): yi(p) = Format(Val(yi(p)), "0.000000")
     
      p = p + le
  Loop Until p > n - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For I = 0 To n - 1 '仅输出模
   zr(I) = xr(I) * yr(I) - xi(I) * yi(I): zi(I) = xr(I) * yi(I) + xi(I) * yr(I)
    zr(I) = Format(Val(zr(I)), "0.000000"): zi(I) = Format(Val(zi(I)), "0.000000")
  

      's = s & "/" & zr(I)
      's1 = s1 & "/" & zi(I)
      Next
      
       J = sb
     
       ReDim x_(1 To sb): ReDim y_(1 To sb)
     For k = 1 To J
         n1 = n1 + 1
          ReDim Preserve x_(1 To n1)
        
         x_(n1) = zr(n1 - 1): y_(n1) = zi(n1 - 1)
         x_(n1) = Format(Val(x_(n1)), "0.000000"): y_(n1) = Format(Val(y_(n1)), "0.000000")
         
       Next
   
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
x_(J + 1) = Format(Val(x_(J + 1)), "0.000000")
y_(J + 1) = Format(Val(y_(J + 1)), "0.000000")
    js = js & "/" & x_(J + 1)
    js1 = js1 & "/" & y_(J + 1)
    Next
    sx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & js
    sy1 = "/" & y_(1) & "/" & y_(1 + sb / 2) & js1
   
   
   
   
   
      
      
     's2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)), Trim(sb1))
     s3 = nifft(Trim(sx1), Trim(sy1), Trim(sb1))
      Text2 = s3 & "有" & Len(s3) & "位,用时" & Timer - ts & "秒"
  End Sub

  Private Sub Command2_Click()
  Text1 = ""
  Text2 = ""
  Text3 = ""
  Form1.Cls
  End Sub

Private Function qdqd0(sa As String) As String
  a = sa
  Do While Left(a, 1) = "0"
  a = Mid(a, 2)
  Loop
  If a = "" Then
  a = 0
  Else
  a = a
  End If
  qdqd0 = a
  End Function

  Private Function nifft(sa As String, sb As String, sb1 As String) As String
  
  Dim xi(): Dim yi(): Dim zi()
  Dim xr(), yr()
  Dim zr() As String
  
  s2 = Split(sa, "/")
  s3 = Split(sb, "/")
      J = UBound(s2)
      n = J
     For k = 1 To J
         n1 = n1 + 1
          ReDim Preserve xr(0 To n1 - 1)
          ReDim Preserve yr(0 To n1 - 1)
         xr(n1 - 1) = s2(n1): yr(n1 - 1) = s3(n1)
         xr(n1 - 1) = Format(Val(xr(n1 - 1)), "0.000000"): yr(n1 - 1) = Format(Val(yr(n1 - 1)), "0.000000")

       Next
     

  ReDim zr(0 To J - 1)

  m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > n
  n = l / 2
  ReDim xi(n - 1): ReDim yi(n - 1): ReDim zi(n - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = -1 * pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     xr(p) = Format(Val(xr(p)), "0.000000"): xi(p) = Format(Val(xi(p)), "0.000000")
     yr(p) = Format(Val(yr(p)), "0.000000"): yi(p) = Format(Val(yi(p)), "0.000000")
      p = p + le
  Loop Until p > n - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For I = 0 To n - 1 '仅输出模
zr(I) = (xr(I) - yi(I)) / n
      zr(I) = Format(Val(zr(I) + 0.5), "0.000000")
     If InStr(zr(I), ".") = 0 Then
     s1 = zr(I)
     Else
     s1 = Left(zr(I), InStr(zr(I), ".") - 1)
      End If
      s = "/" & s1 & s
      zr(I) = s1
      Next
      For i1 = 1 To Val(J - sb1 + 1)
      zr(sb1 + i1 - 2) = 0
      Next
      
     
     
      For i1 = 0 To n - 1
      If zr(i1) < 0 Then
      zr(i1) = "000"
      ElseIf Len(zr(i1)) < 3 Then
      zr(i1) = String(3 - Len(zr(i1)), "0") & zr(i1)
      Else
      zr(i1) = zr(i1)
      End If
      
      s5 = s5 & "/" & zr(i1)
      
      If i1 = 0 Then
      
      s6 = Val(Left(zr(i1), Len(zr(i1)) - 3))
      If Len(s6) < 3 Then
      s6 = String(3 - Len(s6), "0") & s6
      Else
      s6 = s6
      End If
      s8 = Right(zr(i1), 3)
      ElseIf Val(zr(i1)) >= 0 Then
      s7 = Val(zr(i1)) + Val(s6)
         If Len(s7) = 3 Or Len(s7) = 6 Or Len(s7) = 9 Then
          s7 = s7
          Else
          s7 = String(9 - Len(s7), "0") & s7
         End If
      s10 = Right(s7, 3)
      s11 = s10 & s11
      If Len(s7) < 3 Then
      s7 = String(3 - Len(s7), "0") & s7
      ElseIf Len(s7) = 3 Then
      s6 = "000"
      Else
      s7 = s7
      s6 = Val(Left(s7, Len(s7) - 3))
      End If
      Else
      s6 = s6
      End If
     
      Next
      s9 = s6 & s11 & s8
     
  nifft = qdqd0(Trim(s9))

  End Function

  Private Function dxcx0(sa As String, sb As String) As String

  Dim x_() As Double, a As String
    a = Trim(sa)
    ReDim x_(1 To sb)
    For i1 = 1 To sb
    x_(i1) = Mid(a, sb - i1 + 1, 1)
      Next
    Dim n As Integer, I As Long, J As Long, mn As Long, lh As Long, t As Double, k As Long
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
    s = s & x_(J + 1)
    Next
    dxcx0 = x_(1) & x_(1 + sb / 2) & s
   

  End Function

Public Function MbC(D1 As String, D2 As String) As String '乘法
Dim x, Y '两数长度
x = Len(D1): Y = Len(D2)
Dim a() As Integer
ReDim a(1 To x + Y, 1 To Y)
Dim I, J, C1, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
C2 = Mid$(D2, J, 1) '每位数
For I = x To 1 Step -1 'D1
  C1 = Mid$(D1, I, 1) '每位数
  CJ = C1 * C2 + JW '计算乘积
  c = I + J: r = Y + 1 - J
  a(c, r) = CJ Mod 10 '本位
  JW = CJ \ 10 '进位
Next
a(c - 1, r) = JW
Next
Dim b() As Integer
ReDim b(1 To x + Y)
JW = 0
For I = x + Y To 1 Step -1
Bit = JW
For J = 1 To Y
  Bit = Bit + a(I, J)
Next
b(I) = Bit Mod 10
JW = Bit \ 10
Next
If b(1) > 0 Then
MbC = MbC & b(1)
Else
MbC = MbC
End If
For I = 2 To x + Y
MbC = MbC & b(I)
Next
End Function

  Private Function dxcx1(sa As String) As String

  Dim x_() As Double, a As String
    a = Trim(sa)
     

  s2 = Split(sa, "/")
  s3 = Split(sb, "/")
      J = UBound(s2)
      sb = J
     
       ReDim x_(1 To sb)
     For k = 1 To J
         n1 = n1 + 1
          ReDim Preserve x_(1 To n1)
        
         x_(n1) = s2(n1)
       Next
    Dim n As Integer, I As Long, mn As Long, lh As Long, t As Double
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
    s = s & "/" & x_(J + 1)
    Next
    dxcx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & s
   
    End Function


#240
ysr28572021-03-21 21:20
可能会用到如下可调用程序(谁知道加上这么多辅助程序是否会影响速度,当然有的可能就用不上,有的是不必要,尽量不用,移动小数点是必须的)
发出来,明天再弄吧,做个50位一组的验证一下,各位老师晚安!发一下程序:
'移动小数点的程序
Private Function ydxsd(sa As String, sd As String) As String
 If Len(sa) = 1 And Val(sa) = 0 Then
  ydxsd = 0
  Else
  
    sc = InStr(sa, ".")
    If Val(sc) = 0 Then
    ydxsd = sa & String(sd, "0")
    Else
    se = Left(sa, Val(sc) - 1)
    sf = Right(sa, Len(sa) - Val(sc))
    If Val(Len(sf)) >= Val(sd) Then
    ydxsd = se & Mid(sf, 1, sd)
      Else
      ydxsd = se & sf & String(Val(sd) - Len(sf), "0")
      End If
      End If
      End If
      End Function

'符号运算程序
Private Function fhys(sa As String) As String

 If InStr(sa, "-") = 0 Then
  fhys = 1
   Else
   fhys = -1
 End If
 
   
End Function

'添加符号程序
Private Function tjfh(sa As String, sf As String) As String 'qianjia fuhao
If Val(sf) < 0 Then
tjfh = "-" & sa
Else
tjfh = sa
End If

 
 
   
End Function

'带符号的加法程序
Private Function mpc3(sa As String, sb As String) As String 'jiafa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If Val(fh1) * Val(fh2) > 0 Then
ja = MPC1(qdfh(sa), qdfh(sb))


If Val(fh1) > 0 Then
mpc3 = ja
Else
mpc3 = "-" & ja
End If
Else
xd = MBJC(qdfh(sa), qdfh(sb))
If xd >= 0 Then
jb = qqdl(MPC(qdfh(sa), qdfh(sb)))
Else
jb = qqdl(MPC(qdfh(sb), qdfh(sa)))
End If
If xd >= 0 And Val(fh1) > 0 Then
mpc3 = jb
Else
 If xd > 0 And Val(fh1) < 0 Then
 mpc3 = "-" & jb
 Else
 If Val(fh2) < 0 Then
 mpc3 = "-" & jb
 Else
 mpc3 = jb
 End If
 End If
 End If
 End If
 
End Function

'带符号的减法程序
Private Function mpc2(sa As String, sb As String) As String 'jianfa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
xd = MBJC(qqdl(qdfh(sa)), qqdl(qdfh(sb)))
If Val(fh1) * Val(fh2) < 0 Then
ja = MPC1(qdfh(sa), qdfh(sb))


If Val(fh1) > 0 Then
mpc2 = ja
Else

mpc2 = "-" & ja


End If
Else

If xd >= 0 Then
jb = qqdl(MPC(qdfh(sa), qdfh(sb)))
Else
jb = qqdl(MPC(qdfh(sb), qdfh(sa)))
End If
If xd >= 0 And Val(fh1) > 0 Then
mpc2 = jb
Else
 If xd > 0 And Val(fh1) < 0 Then
 mpc2 = "-" & jb
 Else
 If Val(fh2) <= 0 Then
 mpc2 = jb
 Else
 mpc2 = "-" & jb
 End If
 End If
 End If
 End If
 
End Function

'去前导0的程序
Private Function qqdl(sa As String) As String

  
  For i = 1 To Len(sa)
    If Not Mid(sa, i, 1) = "0" Then
        Exit For
    End If
Next
strTmp = Mid(sa, i)
  If Len(strTmp) = 0 Then
  qqdl = "0"
  Else
qqdl = strTmp
 End If
End Function

'带符号的比较大小程序
Private Function mbjc2(sa As String, sb As String) As String 'bi jiao dx daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If Val(fh1) < Val(fh2) Then
mbjc2 = -1
Else
If Val(fh1) > Val(fh2) Then
mbjc2 = 1
Else

ja = MBJC(qdfh(sa), qdfh(sb))

If Val(fh1) > 0 And Val(ja) > 0 Then
mbjc2 = 1
Else
If Val(fh1) < 0 And Val(ja) > 0 Then
mbjc2 = -1
Else
If Val(fh1) > 0 And Val(ja) < 0 Then
mbjc2 = -1
Else
If Val(fh1) < 0 And Val(ja) < 0 Then
mbjc2 = 1
Else
mbjc2 = 0
End If
End If
End If
End If
End If
End If


 
End Function

'带符号的乘法程序
Private Function mbc2(sa As String, sb As String, sd As String) As String 'chengfa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If sa = 0 Or sb = 0 Then
mbc2 = 0
Else


ja = MbC(qdfh(sa), qdfh(sb))
If Val(Len(ja)) > Val(sd) Then
jb = Left(ja, Val(Len(ja)) - Val(sd))

If Val(fh1) * Val(fh2) > 0 Then
mbc2 = jb
Else
mbc2 = "-" & jb
End If

Else
mbc2 = 0
End If
End If



 
End Function

'去掉符号的程序
Private Function qdfh(sa As String) As String

 If InStr(sa, "-") > 0 Then
 qdfh = Mid(sa, 2)
 Else
 If InStr(sa, "+") > 0 Then
 qdfh = Mid(sa, 2)
 Else
 qdfh = sa
 End If
 End If
   
End Function

'减法程序(必须大的减去小的不输出负值):(这个收集进来这回就全了,可以组装起来成为快速程序了)
 Public Function MPC(D1 As String, D2 As String) As String ';jianfaqi
Dim x, Y ';两数长度
If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
d3 = D1
Else
D4 = D2
d3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(d3): Y = Len(D4)
Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
ReDim a(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim E1(1 To x)
Dim I, J, C2, CJ, JW
For J = Y To 1 Step -1 ';D2
JW = 1 ';yu jie weichuzhi
B1(J) = Mid(D4, J, 1) ';每位数
For I = x To 1 Step -1  ';D1
   a(I) = Mid(d3, I, 1) ';每位数
   C1(I) = 10 + a(I) - B1(I) - 1 + JW ';计算jia
   JW = C1(I) \ 10
   E1(I) = C1(I) Mod 10
  Next
  Next
  For r = 1 To x
  MPC = MPC & E1(r)
  For I = 1 To Len(MPC)
    If Not Mid(MPC, I, 1) = "0" Then
        Exit For
    End If
Next
strtmp = Mid(MPC, I)
  If Len(strtmp) = 0 Then
  MPC = "0"
  Else
MPC = strtmp
End If
  Next
  
  
End Function

'比较大小的程序
Public Function MBJC(D1 As String, D2 As String) As String 'bijiao
If Len(D1) > Len(D2) Then
MBJC = 1
Else
If Len(D1) < Len(D2) Then
MBJC = -1
Else
If Len(D1) = Len(D2) And Len(D1) >= 10 Then

 
Dim X, Y
X = Len(D1) \ 4: Y = Len(D2) \ 4
Dim a() As String, b() As String
ReDim a(4 To 4 * X + 4)
ReDim b(4 To 4 * Y + 4)
If Val(Left(D1, Len(D1) - 4 * X)) > Val(Left(D2, Len(D2) - 4 * Y)) Then
 MBJC = 1
 Else
 If Val(Left(D1, Len(D1) - 4 * X)) < Val(Left(D2, Len(D2) - 4 * Y)) Then
 MBJC = -1
 Else
 For i = 4 To 4 * X Step 4
 a(i) = Mid(D1, Len(D1) - i + 1, 4)
 b(i) = Mid(D2, Len(D2) - i + 1, 4)
 Next
 j = 4 * X
 Do While a(j) = b(j) And j >= 8
 
 j = j - 4
    Loop
   
   
  If Val(a(j)) - Val(b(j)) > 0 Then
  MBJC = 1
  Else
  If Val(a(j)) - Val(b(j)) < 0 Then
  MBJC = -1
  Else
  MBJC = 0
  End If
  
 End If
 
 
 
 
End If
End If
End If
If Len(D1) < 10 Then
 ja = Val(D1) - Val(D2)
  If ja > 0 Then
   MBJC = 1
   Else
    If ja = 0 Then
     MBJC = 0
    Else
   
  MBJC = -1
 End If
 End If
 End If
 
End If
End If
End Function

[此贴子已经被作者于2021-3-22 09:05编辑过]

#241
ysr28572021-03-23 00:22
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801*
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801=
2678145490787694710138406683675886762424440548647327525594133873038347266950777818028529804877891353347244255046176220880989519574806598935727647635506939520211209794328712328126947740602255036264392628020291100698432900022333877728824270241063030019536831205264726059774673235680796770108334187808344470141093691232926021244583649747591446066921535333854157441330339217364515328375889937313870826987520723914810358707312468857074455945610038118763873992681688857200178452843740327143990247797893489008808544535536081089994800692174759199578596435124153437689121057209523619989593900355037400039597165241729693472001589594642879166693443994939359639600558001937547209387175085119128575833396037478944824322315197771750730768383267287661855880237549141571520374996029107650341071074081501632143441365461865431362023790463469688071768208320226561675630348708531708110373889241713511809029065048200924851629507265095151843687852114948736130517024578482059771284515915597919026074110811882700307150650858080695566672584075215926450360584738705106755945308199980660478183563586945902705730231409948938478910176292179410952310592864745025373902249844607078729230098512959498522851990040833671698873183076996740726479481352429756295966452788332789259316653805673821716832204368483794501474641036177256005810416507649770210480747056764697918800240201155395628561684853684747063434500664449114760179367086926249813006056735202795763742271472136500817313178050955623517148960973128433455798444839070215800699075256371341531892841721456473301085595261371522078416420399702683504171019191363372883472415693921509069484448792009627325245658854979159002549542769741504596589556474585723101403486046952706847309188488390899096649210853675228464611999630360164703837131620319658277117300208326944026347808645954842782309633205645471959842390075986572806483755223497552549948718545978420793425036666212191832327909389117021539426917904222971515424022606157676379417252939026404363841301595348953340657745965591468370831371449860774296757556463049237248472613472436666799615694672489600751763956185893123579218797539971253828850163437053164723845196089466298000486042246621634263064752906475198879616484926366053597071510886820878425907736453843197228282179943365206039514850477377542684361730162273246709577442085159313947668552462343596819299335060863266863059421286080919061657175757802930378698062290163092494909661982639303946271889619023417245433500782685534406291391527022657608608130680134939380126048353657648559735671562230714451258764762350451448379438849319710473631625533527602085050858633346936315115309333355986556546113134787213610042970405680162084678021281774169131725296977361816657904233850711837826724976507876061043779177845550646612327663283839673950405472039432309339110648301347672597370034346896334064135099613033528785924976781865447506814375627647103020761819104412269362847848884053177378762432543285984193091289854949394023586451139393716370633759317698908834326333339634557238526607966375935960004339535161203546369910853171524516945554862019134684985868547068709986010719120259421723270478586992153989283736650948010894951434857207445141886625290777550599700738909777829412358941157674866550887608199469723859806486384262574182811908513849905040209776132986875560077482527819093584150609347560543627976011009349905362597935257895287412087233810106693141683912683308201407373637490835862452911394718399632093441745957478079754723679119343225931665785380948807114301164623717144211285944154289093317610519159281033583963015810556464180819928345256832572962092994993950655913067768151113345566231088759030148164710287289335782462899525700500822021472132532771242198844498579102733028256523810973405350508253183399668290339844052874956694050028526577775764032598023622192221226501334606994447870277619118208162133562541678250491647671042612088902952091163094215645902682086024337098910110924115381788866213335441814530141911754446270296630426675020592640816713810936850961517475097707179713115856513919631998747192606018612535436009162735908155778165736923393260822217415131632296810207091918499370220533980666393617256227781299273913099896641458499949922475383775878771011361417556799406151773618626138749998464514570482965286184387350245762317271666329142667987131139265167425606863654107927682419958167046956962340419295394058625063862272314570914511355913547470055072878835349142049813368019960713974852351833144227544851625677753419141348585495260230041111323576432417502998832485027071744397105338790364666312325483218209150368759120749671419554589928540715813531144241705501211397506662448276056294585639532800634727428900861538486753011006379264618338782036690340859441153926551954112364946638768223012718907190897165613382555036872673785444132692292217184974818914501886689736449912131900762592363447945036085692999163815947845753538999001633767986447907729462453017601有4888位,用时1.546997秒(优化了一下程序,3位一组的,把3位当一位数计算,去掉了快速逆变换可调用程序,直接把逆变换加再主程序中,居然速度提高了。)
#242
ysr28572021-03-23 00:27
优化了一下程序,3位一组的,把3位当一位数计算,去掉了快速逆变换可调用程序,直接把逆变换加再主程序中,居然速度提高了。下面发一下这个代码:

Dim l As Long, le As Long, le1 As Long, n As Long, r As Long, p As Long, q As Long, m As Byte
  Dim wr As Double, w1 As Double, wlr As Double, wl1 As Double, tr As Double, t1 As Double
  Dim pi As Double, t As Double, tr1 As Double

Private Sub Command1_Click()
  Dim xr() As Double, a As String
  a = Trim(Text1)
  b = Trim(Text3)
  ts = Timer
  
  x = Len(a) \ 3: Y = Len(b) \ 3
  a = String(Val(x * 3 + 3 - Len(a)), "0") & a
  b = String(Val(Y * 3 + 3 - Len(b)), "0") & b
  x = x + 1: Y = Y + 1
  sb1 = x + Y
  sb2 = Log(sb1) / Log(2)
  If InStr(sb2, ".") = 0 Then
  sb2 = sb2
  Else
  sb2 = Int(sb2) + 1
  End If
  sb = 2 ^ sb2
  Print sb
  a = String(Val(sb) * 3 - Len(a), "0") & a
  b = String(Val(sb) * 3 - Len(b), "0") & b
  Print a
  
  
  
   ReDim x_(1 To sb): ReDim y_(1 To sb)
    For i1 = 1 To sb
    x_(i1) = Mid(a, (sb - i1 + 1) * 3 - 2, 3): y_(i1) = Mid(b, (sb - i1 + 1) * 3 - 2, 3)
    If Len(x_(i1)) < 3 Then
    x_(i1) = String(3 - Len(x_(i1)), "0") & x_(i1)
    ElseIf Len(y_(i1)) < 3 Then
    y_(i1) = String(3 - Len(y_(i1)), "0") & y_(i1)
    Else
    x_(i1) = x_(i1): y_(i1) = y_(i1)
    End If
   
      Next
    Dim n As Integer, I As Long, J As Long, mn As Long, lh As Long, t As Double, k As Long
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
    s = s & x_(J + 1)
    s1 = s1 & y_(J + 1)
    Next
    a = x_(1) & x_(1 + sb / 2) & s
    b = y_(1) & y_(1 + sb / 2) & s1
  
  ReDim xr(0 To (Len(a) - 3) \ 3): ReDim yr(0 To (Len(b) - 3) \ 3): ReDim zr(0 To (Len(b) - 3) \ 3)
  If Len(a) = 3 Then
  xr(0) = a: yr(0) = b
  Else
  For i1 = 0 To (Len(a) - 3) \ 3
  xr(i1) = Mid(a, (i1 + 1) * 3 - 2, 3)
  yr(i1) = Mid(b, (i1 + 1) * 3 - 2, 3)

     Next
     End If
  
  Dim xi(): Dim yi(): Dim zi()
  n = sb '求数组大小,其值必须是2的幂
m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > n
  n = l / 2
  ReDim xi(n - 1): ReDim yi(n - 1): ReDim zi(n - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     xr(p) = Format(Val(xr(p)), "0.000000"): xi(p) = Format(Val(xi(p)), "0.000000")
     yr(p) = Format(Val(yr(p)), "0.000000"): yi(p) = Format(Val(yi(p)), "0.000000")
     
      p = p + le
  Loop Until p > n - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For I = 0 To n - 1 '仅输出模
   zr(I) = xr(I) * yr(I) - xi(I) * yi(I): zi(I) = xr(I) * yi(I) + xi(I) * yr(I)
    zr(I) = Format(Val(zr(I)), "0.000000"): zi(I) = Format(Val(zi(I)), "0.000000")
  

      's = s & "/" & zr(I)
      's1 = s1 & "/" & zi(I)
      Next
      
       J = sb
     
       ReDim x_(1 To sb): ReDim y_(1 To sb)
     For k = 1 To J
         n1 = n1 + 1
          ReDim Preserve x_(1 To n1)
        
         x_(n1) = zr(n1 - 1): y_(n1) = zi(n1 - 1)
         x_(n1) = Format(Val(x_(n1)), "0.000000"): y_(n1) = Format(Val(y_(n1)), "0.000000")
         
       Next
   
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
   
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1

xr(I + 1) = x_(J + 1): yr(I + 1) = y_(J + 1)
    js = js & "/" & x_(J + 1)
    js1 = js1 & "/" & y_(J + 1)
    Next
    sx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & js
    sy1 = "/" & y_(1) & "/" & y_(1 + sb / 2) & js1
   xr(0) = x_(1): xr(1) = x_(1 + sb / 2)
   yr(0) = y_(1): yr(1) = y_(1 + sb / 2)
   
   
   ns = Len(a) \ 3: Jn = ns
  
      
  

  ReDim zr(0 To ns - 1)

  m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > ns
  ns = l / 2
  ReDim xi(ns - 1): ReDim yi(ns - 1): ReDim zi(ns - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = -1 * pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     xr(p) = Format(Val(xr(p)), "0.000000"): xi(p) = Format(Val(xi(p)), "0.000000")
     yr(p) = Format(Val(yr(p)), "0.000000"): yi(p) = Format(Val(yi(p)), "0.000000")
      p = p + le
  Loop Until p > ns - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For I = 0 To ns - 1 '仅输出模
zr(I) = (xr(I) - yi(I)) / n
      zr(I) = Format(Val(zr(I) + 0.5), "0.000000")
     If InStr(zr(I), ".") = 0 Then
     s121 = zr(I)
     Else
     s121 = Left(zr(I), InStr(zr(I), ".") - 1)
      End If
      s0 = "/" & s121 & s0
      zr(I) = s121
      Next
      For i1 = 1 To Val(Jn - sb1 + 1)
      zr(sb1 + i1 - 2) = 0
      Next
      
     
     
      For i1 = 0 To n - 1
      If zr(i1) < 0 Then
      zr(i1) = "000"
      ElseIf Len(zr(i1)) < 3 Then
      zr(i1) = String(3 - Len(zr(i1)), "0") & zr(i1)
      Else
      zr(i1) = zr(i1)
      End If
      
      s5 = s5 & "/" & zr(i1)
      
      If i1 = 0 Then
      
      s6 = Val(Left(zr(i1), Len(zr(i1)) - 3))
      If Len(s6) < 3 Then
      s6 = String(3 - Len(s6), "0") & s6
      Else
      s6 = s6
      End If
      s8 = Right(zr(i1), 3)
      ElseIf Val(zr(i1)) >= 0 Then
      s7 = MPC1(Trim(zr(i1)), Trim(s6))
      s10 = Right(s7, 3)
      s11 = s10 & s11
      If Len(s7) < 3 Then
      s7 = String(3 - Len(s7), "0") & s7
      ElseIf Len(s7) = 3 Then
      s6 = "000"
      Else
      s7 = s7
      s6 = Val(Left(s7, Len(s7) - 3))
      End If
      Else
      s6 = s6
      End If
     
      Next
      s9 = s6 & s11 & s8
     
   
   s9 = qdqd0(Trim(s9))
   
      
      
     's2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)), Trim(sb1))
     
     's3 = nifft(Trim(sx1), Trim(sy1), Trim(sb1))
      Text2 = s9 & "有" & Len(s9) & "位,用时" & Timer - ts & "秒"
  End Sub

  Private Sub Command2_Click()
  Text1 = ""
  Text2 = ""
  Text3 = ""
  Form1.Cls
  End Sub

Private Function qdqd0(sa As String) As String
  a = sa
  Do While Left(a, 1) = "0"
  a = Mid(a, 2)
  Loop
  If a = "" Then
  a = 0
  Else
  a = a
  End If
  qdqd0 = a
  End Function

  

  Private Function dxcx0(sa As String, sb As String) As String

  Dim x_() As Double, a As String
    a = Trim(sa)
    ReDim x_(1 To sb)
    For i1 = 1 To sb
    x_(i1) = Mid(a, sb - i1 + 1, 1)
      Next
    Dim n As Integer, I As Long, J As Long, mn As Long, lh As Long, t As Double, k As Long
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
    s = s & x_(J + 1)
    Next
    dxcx0 = x_(1) & x_(1 + sb / 2) & s
   

  End Function

Public Function MbC(D1 As String, D2 As String) As String '乘法
Dim x, Y '两数长度
x = Len(D1): Y = Len(D2)
Dim a() As Integer
ReDim a(1 To x + Y, 1 To Y)
Dim I, J, C1, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
C2 = Mid$(D2, J, 1) '每位数
For I = x To 1 Step -1 'D1
  C1 = Mid$(D1, I, 1) '每位数
  CJ = C1 * C2 + JW '计算乘积
  c = I + J: r = Y + 1 - J
  a(c, r) = CJ Mod 10 '本位
  JW = CJ \ 10 '进位
Next
a(c - 1, r) = JW
Next
Dim b() As Integer
ReDim b(1 To x + Y)
JW = 0
For I = x + Y To 1 Step -1
Bit = JW
For J = 1 To Y
  Bit = Bit + a(I, J)
Next
b(I) = Bit Mod 10
JW = Bit \ 10
Next
If b(1) > 0 Then
MbC = MbC & b(1)
Else
MbC = MbC
End If
For I = 2 To x + Y
MbC = MbC & b(I)
Next
End Function

  Private Function dxcx1(sa As String) As String

  Dim x_() As Double, a As String
    a = Trim(sa)
     

  s2 = Split(sa, "/")
  s3 = Split(sb, "/")
      J = UBound(s2)
      sb = J
     
       ReDim x_(1 To sb)
     For k = 1 To J
         n1 = n1 + 1
          ReDim Preserve x_(1 To n1)
        
         x_(n1) = s2(n1)
       Next
    Dim n As Integer, I As Long, mn As Long, lh As Long, t As Double
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
    s = s & "/" & x_(J + 1)
    Next
    dxcx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & s
   
    End Function
    Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
Dim x, Y '两数长度

If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
d3 = D1
Else
D4 = D2
d3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(d3): Y = Len(D4)
Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
ReDim a(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim E1(1 To x)
Dim I, J, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
B1(J) = Mid$(D4, J, 1) '每位数
For I = x To 1 Step -1  'D1
   a(I) = Mid$(d3, I, 1) '每位数
   C1(I) = a(I) + B1(I) + JW '计算jia
   JW = C1(I) \ 10
   E1(I) = C1(I) Mod 10
  Next
  Next
  For r = 1 To x
  If JW = 0 Then
  MPC1 = MPC1 & E1(r)
  Else
  jc = jc & E1(r)
  MPC1 = JW & jc
  End If
  Next
  
End Function

   
   
    '移动小数点的程序
Private Function ydxsd(sa As String, sd As String) As String
 If Len(sa) = 1 And Val(sa) = 0 Then
  ydxsd = 0
  Else
  
    sc = InStr(sa, ".")
    If Val(sc) = 0 Then
    ydxsd = sa & String(sd, "0")
    Else
    se = Left(sa, Val(sc) - 1)
    sf = Right(sa, Len(sa) - Val(sc))
    If Val(Len(sf)) >= Val(sd) Then
    ydxsd = se & Mid(sf, 1, sd)
      Else
      ydxsd = se & sf & String(Val(sd) - Len(sf), "0")
      End If
      End If
      End If
      End Function

'符号运算程序
Private Function fhys(sa As String) As String

 If InStr(sa, "-") = 0 Then
  fhys = 1
   Else
   fhys = -1
 End If
 
   
End Function

'添加符号程序
Private Function tjfh(sa As String, sf As String) As String 'qianjia fuhao
If Val(sf) < 0 Then
tjfh = "-" & sa
Else
tjfh = sa
End If

 
 
   
End Function

'带符号的加法程序
Private Function mpc3(sa As String, sb As String) As String 'jiafa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If Val(fh1) * Val(fh2) > 0 Then
ja = MPC1(qdfh(sa), qdfh(sb))


If Val(fh1) > 0 Then
mpc3 = ja
Else
mpc3 = "-" & ja
End If
Else
xd = MBJC(qdfh(sa), qdfh(sb))
If xd >= 0 Then
jb = qqdl(MPC(qdfh(sa), qdfh(sb)))
Else
jb = qqdl(MPC(qdfh(sb), qdfh(sa)))
End If
If xd >= 0 And Val(fh1) > 0 Then
mpc3 = jb
Else
 If xd > 0 And Val(fh1) < 0 Then
 mpc3 = "-" & jb
 Else
 If Val(fh2) < 0 Then
 mpc3 = "-" & jb
 Else
 mpc3 = jb
 End If
 End If
 End If
 End If
 
End Function

'带符号的减法程序
Private Function mpc2(sa As String, sb As String) As String 'jianfa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
xd = MBJC(qqdl(qdfh(sa)), qqdl(qdfh(sb)))
If Val(fh1) * Val(fh2) < 0 Then
ja = MPC1(qdfh(sa), qdfh(sb))


If Val(fh1) > 0 Then
mpc2 = ja
Else

mpc2 = "-" & ja


End If
Else

If xd >= 0 Then
jb = qqdl(MPC(qdfh(sa), qdfh(sb)))
Else
jb = qqdl(MPC(qdfh(sb), qdfh(sa)))
End If
If xd >= 0 And Val(fh1) > 0 Then
mpc2 = jb
Else
 If xd > 0 And Val(fh1) < 0 Then
 mpc2 = "-" & jb
 Else
 If Val(fh2) <= 0 Then
 mpc2 = jb
 Else
 mpc2 = "-" & jb
 End If
 End If
 End If
 End If
 
End Function

'去前导0的程序
Private Function qqdl(sa As String) As String

  
  For I = 1 To Len(sa)
    If Not Mid(sa, I, 1) = "0" Then
        Exit For
    End If
Next
strtmp = Mid(sa, I)
  If Len(strtmp) = 0 Then
  qqdl = "0"
  Else
qqdl = strtmp
 End If
End Function

'带符号的比较大小程序
Private Function mbjc2(sa As String, sb As String) As String 'bi jiao dx daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If Val(fh1) < Val(fh2) Then
mbjc2 = -1
Else
If Val(fh1) > Val(fh2) Then
mbjc2 = 1
Else

ja = MBJC(qdfh(sa), qdfh(sb))

If Val(fh1) > 0 And Val(ja) > 0 Then
mbjc2 = 1
Else
If Val(fh1) < 0 And Val(ja) > 0 Then
mbjc2 = -1
Else
If Val(fh1) > 0 And Val(ja) < 0 Then
mbjc2 = -1
Else
If Val(fh1) < 0 And Val(ja) < 0 Then
mbjc2 = 1
Else
mbjc2 = 0
End If
End If
End If
End If
End If
End If


 
End Function

'带符号的乘法程序
Private Function mbc2(sa As String, sb As String, sd As String) As String 'chengfa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If sa = 0 Or sb = 0 Then
mbc2 = 0
Else


ja = MbC(qdfh(sa), qdfh(sb))
If Val(Len(ja)) > Val(sd) Then
jb = Left(ja, Val(Len(ja)) - Val(sd))

If Val(fh1) * Val(fh2) > 0 Then
mbc2 = jb
Else
mbc2 = "-" & jb
End If

Else
mbc2 = 0
End If
End If



 
End Function

'去掉符号的程序
Private Function qdfh(sa As String) As String

 If InStr(sa, "-") > 0 Then
 qdfh = Mid(sa, 2)
 Else
 If InStr(sa, "+") > 0 Then
 qdfh = Mid(sa, 2)
 Else
 qdfh = sa
 End If
 End If
   
End Function

'减法程序(必须大的减去小的不输出负值):(这个收集进来这回就全了,可以组装起来成为快速程序了)
 Public Function MPC(D1 As String, D2 As String) As String ';jianfaqi
Dim x, Y ';两数长度
If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
d3 = D1
Else
D4 = D2
d3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(d3): Y = Len(D4)
Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
ReDim a(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim E1(1 To x)
Dim I, J, C2, CJ, JW
For J = Y To 1 Step -1 ';D2
JW = 1 ';yu jie weichuzhi
B1(J) = Mid(D4, J, 1) ';每位数
For I = x To 1 Step -1  ';D1
   a(I) = Mid(d3, I, 1) ';每位数
   C1(I) = 10 + a(I) - B1(I) - 1 + JW ';计算jia
   JW = C1(I) \ 10
   E1(I) = C1(I) Mod 10
  Next
  Next
  For r = 1 To x
  MPC = MPC & E1(r)
  For I = 1 To Len(MPC)
    If Not Mid(MPC, I, 1) = "0" Then
        Exit For
    End If
Next
strtmp = Mid(MPC, I)
  If Len(strtmp) = 0 Then
  MPC = "0"
  Else
MPC = strtmp
End If
  Next
  
  
End Function

'比较大小的程序
Public Function MBJC(D1 As String, D2 As String) As String 'bijiao
If Len(D1) > Len(D2) Then
MBJC = 1
Else
If Len(D1) < Len(D2) Then
MBJC = -1
Else
If Len(D1) = Len(D2) And Len(D1) >= 10 Then

 
Dim x, Y
x = Len(D1) \ 4: Y = Len(D2) \ 4
Dim a() As String, b() As String
ReDim a(4 To 4 * x + 4)
ReDim b(4 To 4 * Y + 4)
If Val(Left(D1, Len(D1) - 4 * x)) > Val(Left(D2, Len(D2) - 4 * Y)) Then
 MBJC = 1
 Else
 If Val(Left(D1, Len(D1) - 4 * x)) < Val(Left(D2, Len(D2) - 4 * Y)) Then
 MBJC = -1
 Else
 For I = 4 To 4 * x Step 4
 a(I) = Mid(D1, Len(D1) - I + 1, 4)
 b(I) = Mid(D2, Len(D2) - I + 1, 4)
 Next
 J = 4 * x
 Do While a(J) = b(J) And J >= 8
 
 J = J - 4
    Loop
   
   
  If Val(a(J)) - Val(b(J)) > 0 Then
  MBJC = 1
  Else
  If Val(a(J)) - Val(b(J)) < 0 Then
  MBJC = -1
  Else
  MBJC = 0
  End If
  
 End If
 
 
 
 
End If
End If
End If
If Len(D1) < 10 Then
 ja = Val(D1) - Val(D2)
  If ja > 0 Then
   MBJC = 1
   Else
    If ja = 0 Then
     MBJC = 0
    Else
   
  MBJC = -1
 End If
 End If
 End If
 
End If
End If
End Function


[此贴子已经被作者于2021-3-29 14:28编辑过]

#243
ysr28572021-03-23 07:13
回复 230楼 ysr2857
111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*111111111=12345678999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999987654321有221位,用时7.226563E-02秒(这是3位一组的程序结果,速度提高了,改为50位一组的肯定更快,但实现困难,需要继续研究)
#244
ysr28572021-03-23 10:18
回复 243楼 ysr2857
111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111*111111111=12345678999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999987654321有221位,用时6.640625E-02秒(这是4位一组的程序结果,又快了一点点)
#245
ysr28572021-03-23 10:20
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801*
51750801837147361345408953922231823615475578427966187002956389087112242842559611794590895524485015222232340190036677951157401229518412775512617768569186939216558814320044037671525512763073762127357272238470370174050144130962253437215369727381909754581075278888137687950749577751967083233227932391898438489520107788418593104216764745143648165875043861634459264809523254076330115365651752264033578829280651927862062277153553168278640509846511729608378923480331705134467105387853440058108864733429085916392927954109944314725590758950098556991513109760871599045355054258610189920009222629391227784118536578933067532162200768112408111142115021110731900107445187734955403922470144187293970602024056652942406064101184615113779243566842311336047149767396006622923831778833173731302325162741660053390002572456069410383734906953419854919650114722834689335022576764661864630532595250136417800041415827379233503655173380741283758557001102498493237113089198106283487003030225058520047964863929279622015825870972146222540614667928697270131499340362072956956518213266361286372027834000838185920579641835952404678850816456467012890793914108776148483471455515695596694573035435841962871983614397882366460940068418989292218104650923374259244879331938925143014431488635252724366437874702141802712286424754174951797598162531093933772708024046029028652425912112434874797404878317364682580259997737809632860143160557722236459697738869857870982308547756781808568834445404196611833859447257611721058384661943492980180884154939581533269700568975940675513953240040220315659784214936947443784598154082110443748171557676558299300252057475022409541083454882202785077569281268346332901357829843950754331120530978456454396022570647840977328115888711408099894489014427119253061839770890965114853246067272044090282103668762164047374624856119676063310166566519499552342907590495696658359542582469176737197423550084705962160477441546453931948920780829433665262356431973422034925001341330921812806939990688094288773216182971976433480031438271163051341645350474631300965486818841553843112688792803367397276204832936049162335586140151875524537720425345701193713093955432559579831822084761702059241698184717469616732582600658006352069963017377661059372648121969448644394344799369193952197519795756182552461838014896498816263546256621347748100920475049252091842372001283217811864786225692344297842649982716736752004086642881662614773154743879410328420184057019873899911520017723788801=
2678145490787694710138406683675886762424440548647327525594133873038347266950777818028529804877891353347244255046176220880989519574806598935727647635506939520211209794328712328126947740602255036264392628020291100698432900022333877728824270241063030019536831205264726059774673235680796770108334187808344470141093691232926021244583649747591446066921535333854157441330339217364515328375889937313870826987520723914810358707312468857074455945610038118763873992681688857200178452843740327143990247797893489008808544535536081089994800692174759199578596435124153437689121057209523619989593900355037400039597165241729693472001589594642879166693443994939359639600558001937547209387175085119128575833396037478944824322315197771750730768383267287661855880237549141571520374996029107650341071074081501632143441365461865431362023790463469688071768208320226561675630348708531708110373889241713511809029065048200924851629507265095151843687852114948736130517024578482059771284515915597919026074110811882700307150650858080695566672584075215926450360584738705106755945308199980660478183563586945902705730231409948938478910176292179410952310592864745025373902249844607078729230098512959498522851990040833671698873183076996740726479481352429756295966452788332789259316653805673821716832204368483794501474641036177256005810416507649770210480747056764697918800240201155395628561684853684747063434500664449114760179367086926249813006056735202795763742271472136500817313178050955623517148960973128433455798444839070215800699075256371341531892841721456473301085595261371522078416420399702683504171019191363372883472415693921509069484448792009627325245658854979159002549542769741504596589556474585723101403486046952706847309188488390899096649210853675228464611999630360164703837131620319658277117300208326944026347808645954842782309633205645471959842390075986572806483755223497552549948718545978420793425036666212191832327909389117021539426917904222971515424022606157676379417252939026404363841301595348953340657745965591468370831371449860774296757556463049237248472613472436666799615694672489600751763956185893123579218797539971253828850163437053164723845196089466298000486042246621634263064752906475198879616484926366053597071510886820878425907736453843197228282179943365206039514850477377542684361730162273246709577442085159313947668552462343596819299335060863266863059421286080919061657175757802930378698062290163092494909661982639303946271889619023417245433500782685534406291391527022657608608130680134939380126048353657648559735671562230714451258764762350451448379438849319710473631625533527602085050858633346936315115309333355986556546113134787213610042970405680162084678021281774169131725296977361816657904233850711837826724976507876061043779177845550646612327663283839673950405472039432309339110648301347672597370034346896334064135099613033528785924976781865447506814375627647103020761819104412269362847848884053177378762432543285984193091289854949394023586451139393716370633759317698908834326333339634557238526607966375935960004339535161203546369910853171524516945554862019134684985868547068709986010719120259421723270478586992153989283736650948010894951434857207445141886625290777550599700738909777829412358941157674866550887608199469723859806486384262574182811908513849905040209776132986875560077482527819093584150609347560543627976011009349905362597935257895287412087233810106693141683912683308201407373637490835862452911394718399632093441745957478079754723679119343225931665785380948807114301164623717144211285944154289093317610519159281033583963015810556464180819928345256832572962092994993950655913067768151113345566231088759030148164710287289335782462899525700500822021472132532771242198844498579102733028256523810973405350508253183399668290339844052874956694050028526577775764032598023622192221226501334606994447870277619118208162133562541678250491647671042612088902952091163094215645902682086024337098910110924115381788866213335441814530141911754446270296630426675020592640816713810936850961517475097707179713115856513919631998747192606018612535436009162735908155778165736923393260822217415131632296810207091918499370220533980666393617256227781299273913099896641458499949922475383775878771011361417556799406151773618626138749998464514570482965286184387350245762317271666329142667987131139265167425606863654107927682419958167046956962340419295394058625063862272314570914511355913547470055072878835349142049813368019960713974852351833144227544851625677753419141348585495260230041111323576432417502998832485027071744397105338790364666312325483218209150368759120749671419554589928540715813531144241705501211397506662448276056294585639532800634727428900861538486753011006379264618338782036690340859441153926551954112364946638768223012718907190897165613382555036872673785444132692292217184974818914501886689736449912131900762592363447945036085692999163815947845753538999001633767986447907729462453017601有4888位,用时1.355469秒(仅仅快了一点点而已)
#246
ysr28572021-03-23 10:23
把4位一组的快速程序代码发一下,代码如下:

Dim l As Long, le As Long, le1 As Long, n As Long, r As Long, p As Long, q As Long, m As Byte
  Dim wr As Double, w1 As Double, wlr As Double, wl1 As Double, tr As Double, t1 As Double
  Dim pi As Double, t As Double, tr1 As Double

Private Sub Command1_Click()
  Dim xr() As Double, a As String
  a = Trim(Text1)
  b = Trim(Text3)
  ts = Timer
  
  x = Len(a) \ 4: Y = Len(b) \ 4
   a = String(Val(x * 4 + 4 - Len(a)), "0") & a
  b = String(Val(Y * 4 + 4 - Len(b)), "0") & b
  x = x + 1: Y = Y + 1
  sb1 = x + Y
  sb2 = Log(sb1) / Log(2)
  If InStr(sb2, ".") = 0 Then
  sb2 = sb2
  Else
  sb2 = Int(sb2) + 1
  End If
  sb = 2 ^ sb2
  Print sb
  a = String(Val(sb) * 4 - Len(a), "0") & a
  b = String(Val(sb) * 4 - Len(b), "0") & b
  Print a
  
  
  
   ReDim x_(1 To sb): ReDim y_(1 To sb)
    For i1 = 1 To sb
    x_(i1) = Mid(a, (sb - i1 + 1) * 4 - 3, 4): y_(i1) = Mid(b, (sb - i1 + 1) * 4 - 3, 4)
    If Len(x_(i1)) < 4 Then
    x_(i1) = String(4 - Len(x_(i1)), "0") & x_(i1)
    ElseIf Len(y_(i1)) < 4 Then
    y_(i1) = String(4 - Len(y_(i1)), "0") & y_(i1)
    Else
    x_(i1) = x_(i1): y_(i1) = y_(i1)
    End If
   
      Next
    Dim n As Integer, I As Long, J As Long, mn As Long, lh As Long, t As Double, k As Long
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
    s = s & x_(J + 1)
    s1 = s1 & y_(J + 1)
    Next
    a = x_(1) & x_(1 + sb / 2) & s
    b = y_(1) & y_(1 + sb / 2) & s1
  
  ReDim xr(0 To (Len(a) - 4) \ 4): ReDim yr(0 To (Len(b) - 4) \ 4): ReDim zr(0 To (Len(b) - 4) \ 4)
  If Len(a) = 4 Then
  xr(0) = a: yr(0) = b
  Else
  For i1 = 0 To (Len(a) - 4) \ 4
  xr(i1) = Mid(a, (i1 + 1) * 4 - 3, 4)
  yr(i1) = Mid(b, (i1 + 1) * 4 - 3, 4)

     Next
     End If
  
  Dim xi(): Dim yi(): Dim zi()
  n = sb '求数组大小,其值必须是2的幂
m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > n
  n = l / 2
  ReDim xi(n - 1): ReDim yi(n - 1): ReDim zi(n - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     xr(p) = Format(Val(xr(p)), "0.000000"): xi(p) = Format(Val(xi(p)), "0.000000")
     yr(p) = Format(Val(yr(p)), "0.000000"): yi(p) = Format(Val(yi(p)), "0.000000")
     
      p = p + le
  Loop Until p > n - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For I = 0 To n - 1 '仅输出模
   zr(I) = xr(I) * yr(I) - xi(I) * yi(I): zi(I) = xr(I) * yi(I) + xi(I) * yr(I)
    zr(I) = Format(Val(zr(I)), "0.000000"): zi(I) = Format(Val(zi(I)), "0.000000")
  

      's = s & "/" & zr(I)
      's1 = s1 & "/" & zi(I)
      Next
      
       J = sb
     
       ReDim x_(1 To sb): ReDim y_(1 To sb)
     For k = 1 To J
         n1 = n1 + 1
          ReDim Preserve x_(1 To n1)
        
         x_(n1) = zr(n1 - 1): y_(n1) = zi(n1 - 1)
         x_(n1) = Format(Val(x_(n1)), "0.000000"): y_(n1) = Format(Val(y_(n1)), "0.000000")
         
       Next
   
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
   
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1

xr(I + 1) = x_(J + 1): yr(I + 1) = y_(J + 1)
    js = js & "/" & x_(J + 1)
    js1 = js1 & "/" & y_(J + 1)
    Next
    sx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & js
    sy1 = "/" & y_(1) & "/" & y_(1 + sb / 2) & js1
   xr(0) = x_(1): xr(1) = x_(1 + sb / 2)
   yr(0) = y_(1): yr(1) = y_(1 + sb / 2)
   
   
   ns = Len(a) \ 4: Jn = ns
  
      
  

  ReDim zr(0 To ns - 1)

  m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > ns
  ns = l / 2
  ReDim xi(ns - 1): ReDim yi(ns - 1): ReDim zi(ns - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = -1 * pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     xr(p) = Format(Val(xr(p)), "0.000000"): xi(p) = Format(Val(xi(p)), "0.000000")
     yr(p) = Format(Val(yr(p)), "0.000000"): yi(p) = Format(Val(yi(p)), "0.000000")
      p = p + le
  Loop Until p > ns - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For I = 0 To ns - 1 '仅输出模
zr(I) = (xr(I) - yi(I)) / n
      zr(I) = Format(Val(zr(I) + 0.5), "0.000000")
     If InStr(zr(I), ".") = 0 Then
     s121 = zr(I)
     Else
     s121 = Left(zr(I), InStr(zr(I), ".") - 1)
      End If
      s0 = "/" & s121 & s0
      zr(I) = s121
      Next
      For i1 = 1 To Val(Jn - sb1 + 1)
      zr(sb1 + i1 - 2) = 0
      Next
      
     
     
      For i1 = 0 To n - 1
      If zr(i1) < 0 Then
      zr(i1) = "0000"
      ElseIf Len(zr(i1)) < 4 Then
      zr(i1) = String(4 - Len(zr(i1)), "0") & zr(i1)
      Else
      zr(i1) = zr(i1)
      End If
      
      s5 = s5 & "/" & zr(i1)
      
      If i1 = 0 Then
      
      s6 = Val(Left(zr(i1), Len(zr(i1)) - 4))
      If Len(s6) < 4 Then
      s6 = String(4 - Len(s6), "0") & s6
      Else
      s6 = s6
      End If
      s8 = Right(zr(i1), 4)
      ElseIf Val(zr(i1)) >= 0 Then
      s7 = MPC1(Trim(zr(i1)), Trim(s6))
      s10 = Right(s7, 4)
      s11 = s10 & s11
      If Len(s7) < 4 Then
      s7 = String(4 - Len(s7), "0") & s7
      ElseIf Len(s7) = 4 Then
      s6 = "0000"
      Else
      s7 = s7
      s6 = Val(Left(s7, Len(s7) - 4))
      End If
      Else
      s6 = s6
      End If
     
      Next
      s9 = s6 & s11 & s8
     
   
   s9 = qdqd0(Trim(s9))
   
      
      
     's2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)), Trim(sb1))
     
     's3 = nifft(Trim(sx1), Trim(sy1), Trim(sb1))
      Text2 = s9 & "有" & Len(s9) & "位,用时" & Timer - ts & "秒"
  End Sub

  Private Sub Command2_Click()
  Text1 = ""
  Text2 = ""
  Text3 = ""
  Form1.Cls
  End Sub

Private Function qdqd0(sa As String) As String
  a = sa
  Do While Left(a, 1) = "0"
  a = Mid(a, 2)
  Loop
  If a = "" Then
  a = 0
  Else
  a = a
  End If
  qdqd0 = a
  End Function

  

  Private Function dxcx0(sa As String, sb As String) As String

  Dim x_() As Double, a As String
    a = Trim(sa)
    ReDim x_(1 To sb)
    For i1 = 1 To sb
    x_(i1) = Mid(a, sb - i1 + 1, 1)
      Next
    Dim n As Integer, I As Long, J As Long, mn As Long, lh As Long, t As Double, k As Long
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
    s = s & x_(J + 1)
    Next
    dxcx0 = x_(1) & x_(1 + sb / 2) & s
   

  End Function

Public Function MbC(D1 As String, D2 As String) As String '乘法
Dim x, Y '两数长度
x = Len(D1): Y = Len(D2)
Dim a() As Integer
ReDim a(1 To x + Y, 1 To Y)
Dim I, J, C1, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
C2 = Mid$(D2, J, 1) '每位数
For I = x To 1 Step -1 'D1
  C1 = Mid$(D1, I, 1) '每位数
  CJ = C1 * C2 + JW '计算乘积
  c = I + J: r = Y + 1 - J
  a(c, r) = CJ Mod 10 '本位
  JW = CJ \ 10 '进位
Next
a(c - 1, r) = JW
Next
Dim b() As Integer
ReDim b(1 To x + Y)
JW = 0
For I = x + Y To 1 Step -1
Bit = JW
For J = 1 To Y
  Bit = Bit + a(I, J)
Next
b(I) = Bit Mod 10
JW = Bit \ 10
Next
If b(1) > 0 Then
MbC = MbC & b(1)
Else
MbC = MbC
End If
For I = 2 To x + Y
MbC = MbC & b(I)
Next
End Function

  Private Function dxcx1(sa As String) As String

  Dim x_() As Double, a As String
    a = Trim(sa)
     

  s2 = Split(sa, "/")
  s3 = Split(sb, "/")
      J = UBound(s2)
      sb = J
     
       ReDim x_(1 To sb)
     For k = 1 To J
         n1 = n1 + 1
          ReDim Preserve x_(1 To n1)
        
         x_(n1) = s2(n1)
       Next
    Dim n As Integer, I As Long, mn As Long, lh As Long, t As Double
    '位序倒置
n = sb '求数组大小,其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的,高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0,则检查新的次高位
J = J + k '非则若最高位是0,则置1
    s = s & "/" & x_(J + 1)
    Next
    dxcx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & s
   
    End Function
    Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
Dim x, Y '两数长度

If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
d3 = D1
Else
D4 = D2
d3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(d3): Y = Len(D4)
Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
ReDim a(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim E1(1 To x)
Dim I, J, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
B1(J) = Mid$(D4, J, 1) '每位数
For I = x To 1 Step -1  'D1
   a(I) = Mid$(d3, I, 1) '每位数
   C1(I) = a(I) + B1(I) + JW '计算jia
   JW = C1(I) \ 10
   E1(I) = C1(I) Mod 10
  Next
  Next
  For r = 1 To x
  If JW = 0 Then
  MPC1 = MPC1 & E1(r)
  Else
  jc = jc & E1(r)
  MPC1 = JW & jc
  End If
  Next
  
End Function

   
   
    '移动小数点的程序
Private Function ydxsd(sa As String, sd As String) As String
 If Len(sa) = 1 And Val(sa) = 0 Then
  ydxsd = 0
  Else
  
    sc = InStr(sa, ".")
    If Val(sc) = 0 Then
    ydxsd = sa & String(sd, "0")
    Else
    se = Left(sa, Val(sc) - 1)
    sf = Right(sa, Len(sa) - Val(sc))
    If Val(Len(sf)) >= Val(sd) Then
    ydxsd = se & Mid(sf, 1, sd)
      Else
      ydxsd = se & sf & String(Val(sd) - Len(sf), "0")
      End If
      End If
      End If
      End Function

'符号运算程序
Private Function fhys(sa As String) As String

 If InStr(sa, "-") = 0 Then
  fhys = 1
   Else
   fhys = -1
 End If
 
   
End Function

'添加符号程序
Private Function tjfh(sa As String, sf As String) As String 'qianjia fuhao
If Val(sf) < 0 Then
tjfh = "-" & sa
Else
tjfh = sa
End If

 
 
   
End Function

'带符号的加法程序
Private Function mpc3(sa As String, sb As String) As String 'jiafa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If Val(fh1) * Val(fh2) > 0 Then
ja = MPC1(qdfh(sa), qdfh(sb))


If Val(fh1) > 0 Then
mpc3 = ja
Else
mpc3 = "-" & ja
End If
Else
xd = MBJC(qdfh(sa), qdfh(sb))
If xd >= 0 Then
jb = qqdl(MPC(qdfh(sa), qdfh(sb)))
Else
jb = qqdl(MPC(qdfh(sb), qdfh(sa)))
End If
If xd >= 0 And Val(fh1) > 0 Then
mpc3 = jb
Else
 If xd > 0 And Val(fh1) < 0 Then
 mpc3 = "-" & jb
 Else
 If Val(fh2) < 0 Then
 mpc3 = "-" & jb
 Else
 mpc3 = jb
 End If
 End If
 End If
 End If
 
End Function

'带符号的减法程序
Private Function mpc2(sa As String, sb As String) As String 'jianfa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
xd = MBJC(qqdl(qdfh(sa)), qqdl(qdfh(sb)))
If Val(fh1) * Val(fh2) < 0 Then
ja = MPC1(qdfh(sa), qdfh(sb))


If Val(fh1) > 0 Then
mpc2 = ja
Else

mpc2 = "-" & ja


End If
Else

If xd >= 0 Then
jb = qqdl(MPC(qdfh(sa), qdfh(sb)))
Else
jb = qqdl(MPC(qdfh(sb), qdfh(sa)))
End If
If xd >= 0 And Val(fh1) > 0 Then
mpc2 = jb
Else
 If xd > 0 And Val(fh1) < 0 Then
 mpc2 = "-" & jb
 Else
 If Val(fh2) <= 0 Then
 mpc2 = jb
 Else
 mpc2 = "-" & jb
 End If
 End If
 End If
 End If
 
End Function

'去前导0的程序
Private Function qqdl(sa As String) As String

  
  For I = 1 To Len(sa)
    If Not Mid(sa, I, 1) = "0" Then
        Exit For
    End If
Next
strtmp = Mid(sa, I)
  If Len(strtmp) = 0 Then
  qqdl = "0"
  Else
qqdl = strtmp
 End If
End Function

'带符号的比较大小程序
Private Function mbjc2(sa As String, sb As String) As String 'bi jiao dx daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If Val(fh1) < Val(fh2) Then
mbjc2 = -1
Else
If Val(fh1) > Val(fh2) Then
mbjc2 = 1
Else

ja = MBJC(qdfh(sa), qdfh(sb))

If Val(fh1) > 0 And Val(ja) > 0 Then
mbjc2 = 1
Else
If Val(fh1) < 0 And Val(ja) > 0 Then
mbjc2 = -1
Else
If Val(fh1) > 0 And Val(ja) < 0 Then
mbjc2 = -1
Else
If Val(fh1) < 0 And Val(ja) < 0 Then
mbjc2 = 1
Else
mbjc2 = 0
End If
End If
End If
End If
End If
End If


 
End Function

'带符号的乘法程序
Private Function mbc2(sa As String, sb As String, sd As String) As String 'chengfa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If sa = 0 Or sb = 0 Then
mbc2 = 0
Else


ja = MbC(qdfh(sa), qdfh(sb))
If Val(Len(ja)) > Val(sd) Then
jb = Left(ja, Val(Len(ja)) - Val(sd))

If Val(fh1) * Val(fh2) > 0 Then
mbc2 = jb
Else
mbc2 = "-" & jb
End If

Else
mbc2 = 0
End If
End If



 
End Function

'去掉符号的程序
Private Function qdfh(sa As String) As String

 If InStr(sa, "-") > 0 Then
 qdfh = Mid(sa, 2)
 Else
 If InStr(sa, "+") > 0 Then
 qdfh = Mid(sa, 2)
 Else
 qdfh = sa
 End If
 End If
   
End Function

'减法程序(必须大的减去小的不输出负值):(这个收集进来这回就全了,可以组装起来成为快速程序了)
 Public Function MPC(D1 As String, D2 As String) As String ';jianfaqi
Dim x, Y ';两数长度
If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
d3 = D1
Else
D4 = D2
d3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(d3): Y = Len(D4)
Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
ReDim a(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim E1(1 To x)
Dim I, J, C2, CJ, JW
For J = Y To 1 Step -1 ';D2
JW = 1 ';yu jie weichuzhi
B1(J) = Mid(D4, J, 1) ';每位数
For I = x To 1 Step -1  ';D1
   a(I) = Mid(d3, I, 1) ';每位数
   C1(I) = 10 + a(I) - B1(I) - 1 + JW ';计算jia
   JW = C1(I) \ 10
   E1(I) = C1(I) Mod 10
  Next
  Next
  For r = 1 To x
  MPC = MPC & E1(r)
  For I = 1 To Len(MPC)
    If Not Mid(MPC, I, 1) = "0" Then
        Exit For
    End If
Next
strtmp = Mid(MPC, I)
  If Len(strtmp) = 0 Then
  MPC = "0"
  Else
MPC = strtmp
End If
  Next
  
  
End Function

'比较大小的程序
Public Function MBJC(D1 As String, D2 As String) As String 'bijiao
If Len(D1) > Len(D2) Then
MBJC = 1
Else
If Len(D1) < Len(D2) Then
MBJC = -1
Else
If Len(D1) = Len(D2) And Len(D1) >= 10 Then

 
Dim x, Y
x = Len(D1) \ 4: Y = Len(D2) \ 4
Dim a() As String, b() As String
ReDim a(4 To 4 * x + 4)
ReDim b(4 To 4 * Y + 4)
If Val(Left(D1, Len(D1) - 4 * x)) > Val(Left(D2, Len(D2) - 4 * Y)) Then
 MBJC = 1
 Else
 If Val(Left(D1, Len(D1) - 4 * x)) < Val(Left(D2, Len(D2) - 4 * Y)) Then
 MBJC = -1
 Else
 For I = 4 To 4 * x Step 4
 a(I) = Mid(D1, Len(D1) - I + 1, 4)
 b(I) = Mid(D2, Len(D2) - I + 1, 4)
 Next
 J = 4 * x
 Do While a(J) = b(J) And J >= 8
 
 J = J - 4
    Loop
   
   
  If Val(a(J)) - Val(b(J)) > 0 Then
  MBJC = 1
  Else
  If Val(a(J)) - Val(b(J)) < 0 Then
  MBJC = -1
  Else
  MBJC = 0
  End If
  
 End If
 
 
 
 
End If
End If
End If
If Len(D1) < 10 Then
 ja = Val(D1) - Val(D2)
  If ja > 0 Then
   MBJC = 1
   Else
    If ja = 0 Then
     MBJC = 0
    Else
   
  MBJC = -1
 End If
 End If
 End If
 
End If
End If
End Function




[此贴子已经被作者于2021-3-29 14:16编辑过]

#247
ysr28572021-03-23 10:27
回复 227楼 ysr2857
999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999*9=8999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999991有271位,用时0.0859375秒(明显快了一点点)
#248
ysr28572021-03-25 01:55
4999999999999999999999999有25位,用时2.197266E-02秒(这个是我的程序计算的60度的余弦值点后25位,可以用于8位一组的利用快速傅里叶变换的乘法程序,50位的就慢些(可用于16位一组的快速乘法),大约0.15秒,150位的(可用于48位一组的快速乘法)更慢大约4.5秒,要想提高计算正弦余弦的速度看来必须改变算法,可以用到秦九韶算法,用到秦九韶多项式,就是把泰勒级数展开式写成秦九韶多项式,就是有多层括号的多项式,由内向外逐层计算,迭代几次就可以达到精度,希望老师指点!欢迎指导,欢迎提供更好的方法。)

50000000000000000000000000000000000000000000000001有50位,用时0.1572266秒

500000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000有150位,用时4.741211秒

有空试试8位一组的就是把8位当作1位数,看看能不能提高速度(因为要多次用到正弦余弦值,前面的速度还是不够快,得不偿失的话,速度不一定能快),有空再试试吧。
各位老师晚安!!
#249
ysr28572021-03-25 01:58
下面把这个程序传一下:

Private Sub Command1_Click() '快速求高精度三角函数的实验程序
Dim a, b
  a = Trim(Text1): b = Trim(Text2): b3 = b: a3 = a
  ts = Timer
  
  a2 = zhengchuqy(MCC1(jspaizh(Val(150)), Val(3)))
  a1 = jsyuxian(Trim(a2), Val(150))
  
  
  Text3 = a1 & "有" & Len(a1) & "位,用时" & Timer - ts & "秒"
 
  End Sub

  Private Sub Command2_Click()
  Text1 = ""
  Text2 = ""
  Text3 = ""

  End Sub
  
  Private Function mpc3(sa As String, sb As String) As String 'jiafa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If Val(fh1) * Val(fh2) > 0 Then
ja = MPC1(qdfh(sa), qdfh(sb))


If Val(fh1) > 0 Then
mpc3 = ja
Else
mpc3 = "-" & ja
End If
Else
xd = MBJC(qdfh(sa), qdfh(sb))
If xd >= 0 Then
jb = qqdl(MPC(qdfh(sa), qdfh(sb)))
Else
jb = qqdl(MPC(qdfh(sb), qdfh(sa)))
End If
If xd >= 0 And Val(fh1) > 0 Then
mpc3 = jb
Else
If xd > 0 And Val(fh1) < 0 Then
mpc3 = "-" & jb
Else
If Val(fh2) < 0 Then
mpc3 = "-" & jb
Else
mpc3 = jb
End If
End If
End If
End If

End Function
  
  
  Private Function jspaizh(sd As String) As String '派/2=1+1/3+1*2/3*5+1*2*3/3*5*7+……
'应该是 Pi/4=1-1/3+1/5-1/7+…+(-1)^(n-1)/(2*n-1)吧,呵呵
'派/2=2/1*2/3*4/3*4/5^^^^^=2*2/1*3*4*4/3*5*6*6/5*7*^^^^^^^
Dim s1 As String
s1 = "31415926535 8979323846 2643383279 5028841971 6939937510 5820974944 5923078164 0628620899 8628034825 3421170679 8214808651 32823066470938446095 5058223172 5359408128 4811174502 8410270193 8521105559 6446229489 5493038196 4428810975 6659334461 2847564823 37867831652712019091 4564856692 3460348610 4543266482 1339360726 0249141273 7245870066 0631558817 4881520920 9628292540 9171536436 7892590360" _
& "0113305305 4882046652 1384146951 9415116094 3305727036 5759591953 0921861173 8193261179 3105118548 0744623799 6274956735 1885752724" _
& "8912279381 8301194912 9833673362 4406566430 8602139494 6395224737 1907021798 6094370277 0539217176 2931767523 8467481846 7669405132" _
& "0005681271 4526356082 7785771342 7577896091 7363717872 1468440901 2249534301 4654958537 1050792279 6892589235 4201995611 2129021960" _
& "8640344181 5981362977 4771309960 5187072113 4999999837 2978049951 0597317328 1609631859 5024459455 3469083026 4252230825 3344685035"
s2 = DeleteSpace(s1)
jspaizh = Left(s2, Val(sd) + 1)

End Function

Public Function DeleteSpace(Tmp As String) As String
   Dim Inst As Integer
   Do
       Tmp = Replace(Tmp, " ", "")
       DoEvents
       Inst = InStr(Tmp, " ")
   Loop While Inst > 0
   DeleteSpace = Tmp
End Function

Private Function jcjs(sa As String) As String

Dim s
s = 1
For I = 1 To sa
s = MbC(Trim(s), Val(I))
Next
jcjs = s



   
End Function
  
  Private Function tjfh(sa As String, sf As String) As String 'qianjia fuhao
If Val(sf) < 0 Then
tjfh = "-" & sa
Else
tjfh = sa
End If

   
End Function
  
  Private Function qqdl(sa As String) As String

  
  For I = 1 To Len(sa)
    If Not Mid(sa, I, 1) = "0" Then
        Exit For
    End If
Next
strTmp = Mid(sa, I)
  If Len(strTmp) = 0 Then
  qqdl = "0"
  Else
qqdl = strTmp
 End If
End Function
  
 Private Function jszhxian(sa As String, sd As String) As String
Dim s1
s1 = 1 & String(Val(sd), "0")
s2 = mbc2(Trim(sa), Trim(sa), Val(sd))
fs1 = -1
s3 = 3
Do While MBJC(zhengchuqy(MCC1(Trim(s1), jcjs(Val(s3)))), 1) >= 0
s1 = mbc2(Trim(s1), Trim(s2), Val(sd))

s = mpc3(Trim(s), tjfh(zhengchuqy(MCC1(Trim(s1), jcjs(Val(s3)))), Val(fs1)))

s3 = Val(Val(s3) + 2)

fs1 = Val(-1) * Val(fs1)


Loop

jszhxian = mbc2(Trim(sa), mpc3(Val(1) & String(Val(sd), "0"), Trim(s)), Val(sd))
End Function


Private Function zhengchuqy(sa As String) As String
If InStr(sa, "/") = 0 Then
zhengchuqy = sa
Else
zhengchuqy = Left(sa, InStr(sa, "/") - 1)
End If


End Function

Private Function jsyuxian(sa As String, sd As String) As String
If MBJC(qdfh(Trim(sa)), 1 & String(sd, "0")) = 1 Then
js = zhengchuqy(MCC1(Trim(jspaizh(sd)), Val(2)))
jsyuxian = jszhxian(MPC(Trim(js), qdfh(Trim(sa))), Val(sd))
Else
Dim s1
s1 = 1 & String(Val(sd), "0")
s2 = mbc2(Trim(sa), Trim(sa), Val(sd))
fs1 = -1
s3 = 2
Do While MBJC(zhengchuqy(MCC1(Trim(s1), jcjs(Val(s3)))), 1) >= 0
s1 = mbc2(Trim(s1), Trim(s2), Val(sd))

s = mpc3(Trim(s), tjfh(zhengchuqy(MCC1(Trim(s1), jcjs(Val(s3)))), Val(fs1)))

s3 = Val(Val(s3) + 2)

fs1 = Val(-1) * Val(fs1)


Loop

jsyuxian = mpc3(Val(1) & String(Val(sd), "0"), Trim(s))
End If
End Function

Private Function qdfh(sa As String) As String

If InStr(sa, "-") > 0 Then
qdfh = Mid(sa, 2)
Else
If InStr(sa, "+") > 0 Then
qdfh = Mid(sa, 2)
Else
qdfh = sa
End If
End If


   
End Function

  Private Function fhys(sa As String) As String

If InStr(sa, "-") = 0 Then
  fhys = 1
   Else
   fhys = -1
End If

   
End Function
  
  Private Function mpc2(sa As String, sb As String) As String 'jianfa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
xd = MBJC(qqdl(qdfh(sa)), qqdl(qdfh(sb)))
If Val(fh1) * Val(fh2) < 0 Then
ja = MPC1(qdfh(sa), qdfh(sb))


If Val(fh1) > 0 Then
mpc2 = ja
Else

mpc2 = "-" & ja


End If
Else

If xd >= 0 Then
jb = qqdl(MPC(qdfh(sa), qdfh(sb)))
Else
jb = qqdl(MPC(qdfh(sb), qdfh(sa)))
End If
If xd >= 0 And Val(fh1) > 0 Then
mpc2 = jb
Else
If xd > 0 And Val(fh1) < 0 Then
mpc2 = "-" & jb
Else
If Val(fh2) <= 0 Then
mpc2 = jb
Else
mpc2 = "-" & jb
End If
End If
End If
End If

End Function

Private Function mcc2(sa As String, sb As String, sd As String) As String 'chufa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)


ja = MCC1(qdfh(sa) & String(sd, "0"), qdfh(Trim(sb)))
If InStr(ja, "/") = 0 And Val(fh1) * Val(fh2) > 0 Then
mcc2 = ja
Else
If InStr(ja, "/") = 0 And Val(fh1) * Val(fh2) < 0 Then
mcc2 = "-" & ja
Else
If Val(fh1) * Val(fh2) > 0 Then
mcc2 = Left(ja, InStr(ja, "/") - 1)
Else
mcc2 = "-" & Left(ja, InStr(ja, "/") - 1)
End If
End If
End If



End Function
  
  Private Function mbc2(sa As String, sb As String, sd As String) As String 'chengfa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If sa = 0 Or sb = 0 Then
mbc2 = 0
Else


ja = MbC(qdfh(sa), qdfh(sb))
If Val(Len(ja)) > Val(sd) Then
jb = Left(ja, Val(Len(ja)) - Val(sd))

If Val(fh1) * Val(fh2) > 0 Then
mbc2 = jb
Else
mbc2 = "-" & jb
End If

Else
mbc2 = 0
End If
End If




End Function

Private Function qdhz0(sa As String) As String
  a = sa
  Do While Right(a, 1) = "0"
  a = Left(a, Len(a) - 1)
  Loop
  If a = "" Then
  a = 0
  Else
  a = a
  End If
  qdhz0 = a
  End Function


  Private Function qdqd0(sa As String) As String
  a = sa
  Do While Left(a, 1) = "0"
  a = Mid(a, 2)
  Loop
  If a = "" Then
  a = 0
  Else
  a = a
  End If
  qdqd0 = a
  End Function

  Private Function tjxsd(sa As String, sd As String) As String
  If Val(Len(sa)) > Val(sd) Then
  tjxsd = Left(sa, Val(Len(sa)) - Val(sd)) & "." & Mid(sa, Val(Len(sa)) - Val(sd) + 1)
  Else
  If Val(Len(sa)) = Val(sd) Then
    tjxsd = "0." & sa
    Else
    tjxsd = "0." & String(Val(sd) - Val(Len(sa)), "0") & Trim(sa)
    End If
    End If

  End Function

  Private Function ydxsd(sa As String, sd As String) As String
  If Len(sa) = 1 And Val(sa) = 0 Then
    ydxsd = 0
    Else
   
      sc = InStr(sa, ".")
      If Val(sc) = 0 Then
      ydxsd = sa & String(sd, "0")
      Else
      se = Left(sa, Val(sc) - 1)
      sf = Right(sa, Len(sa) - Val(sc))
      If Val(Len(sf)) >= Val(sd) Then
      ydxsd = se & Mid(sf, 1, sd)
        Else
        ydxsd = se & sf & String(Val(sd) - Len(sf), "0")
        End If
        End If
        End If
        End Function
        
        Public Function MbC(D1 As String, D2 As String) As String '乘法
Dim x, Y '两数长度
x = Len(D1): Y = Len(D2)
  Dim a() As Integer
  ReDim a(1 To x + Y, 1 To Y)
  Dim I, J, C1, C2, CJ, JW
  For J = Y To 1 Step -1 'D2
  JW = 0 '进位清0
  C2 = Mid$(D2, J, 1) '每位数
For I = x To 1 Step -1 'D1
    C1 = Mid$(D1, I, 1) '每位数
  CJ = C1 * C2 + JW '计算乘积
  c = I + J: r = Y + 1 - J
    a(c, r) = CJ Mod 10 '本位
  JW = CJ \ 10 '进位
Next
  a(c - 1, r) = JW
  Next
  Dim b() As Integer
  ReDim b(1 To x + Y)
  JW = 0
  For I = x + Y To 1 Step -1
  Bit = JW
  For J = 1 To Y
    Bit = Bit + a(I, J)
  Next
  b(I) = Bit Mod 10
  JW = Bit \ 10
  Next
  If b(1) > 0 Then
  MbC = MbC & b(1)
  Else
  MbC = MbC
  End If
  For I = 2 To x + Y
  MbC = MbC & b(I)
  Next
  End Function

  Public Function MPC(D1 As String, D2 As String) As String ';jianfaqi
  Dim x, Y ';两数长度
If Len(D1) >= Len(D2) Then
  d4 = String(Len(D1) - Len(D2), "0") & D2
  d3 = D1
  Else
  d4 = D2
  d3 = String(Len(D2) - Len(D1), "0") & D1
  End If
  x = Len(d3) \ 8: Y = Len(d4) \ 8
  If Len(d3) > 8 * x Then
  d3 = String(8 * x + 8 - Len(d3), "0") & d3
  d4 = String(8 * Y + 8 - Len(d4), "0") & d4
  x = x + 1: Y = Y + 1
  Else
  x = x: Y = Y
  d3 = d3: d4 = d4
  End If
  
  Dim a() As String, B1() As String, C1() As String, E1() As String
  ReDim a(1 To x)
  ReDim B1(1 To Y)
  ReDim C1(1 To x)
  ReDim E1(1 To x)
  Dim I, J, C2, CJ, JW
  For J = Y To 1 Step -1 ';D2
  JW = 1 ';yu jie weichuzhi
  B1(J) = Mid(d4, J * 8 - 7, 8) ';每位数
For I = x To 1 Step -1  ';D1
     a(I) = Mid(d3, I * 8 - 7, 8) ';每位数
   C1(I) = Val(1 & a(I)) - Val(B1(I)) - Val(1) + Val(JW) ';计算jia
     JW = C1(I) \ 10 ^ 8
     E1(I) = C1(I) Mod 10 ^ 8
     If Len(E1(I)) < 8 Then
     E1(I) = String(8 - Len(E1(I)), "0") & E1(I)
     Else
     E1(I) = E1(I)
     End If
     
    Next
    Next
    For r = 1 To x
    MPC = MPC & E1(r)
    If Len(MPC) > Len(D1) Then
    MPC = Mid(MPC, Len(MPC) - Len(D1) + 1)
    Else
    MPC = MPC
    End If
    For I = 1 To Len(MPC)
      If Not Mid(MPC, I, 1) = "0" Then
          Exit For
      End If
  Next
  strTmp = Mid(MPC, I)
    If Len(strTmp) = 0 Then
    MPC = "0"
    Else
  MPC = strTmp
  End If
    Next
   
   
  End Function
   
    Public Function MCC1(D1 As String, D2 As String) As String ';大整数的除法
Dim ss
ss = MBJC(D1, D2)
If ss = -1 Then
MCC1 = "0" & "/" & D1
  Else
  If ss = 0 Then
   MCC1 = 1
   Else
   If Len(D1) = Len(D2) Then
     s = Val(Left(D1, 1)) \ Val(Left(D2, 1))

Do While MBJC(MbC(Trim(s), Trim(D2)), D1) = 1
  s = s - 1
  Loop
  If MBJC(MbC(Trim(s), Trim(D2)), D1) = 0 Then
   MCC1 = s
   Else
   MCC1 = s & "/" & MPC(Trim(D1), MbC(Trim(s), Trim(D2)))

End If
    Else
    If Len(D2) < 9 Then
     MCC1 = MCC(D1, D2)
     Else
    Dim x, Y ';定义分段长度
    x = Len(D1): Y = Len(D2)
   
Dim JW, jcc, jss, jcs

  Dim a() As String, b() As String
  
  ReDim a(1 To x)
  ReDim b(1 To Y)
  For I = 1 To x
  a(I) = Mid(D1, I, 1)
  Next
  For J = 1 To Y
  b(J) = Mid(D2, J, 1)
  Next
  jcc = Val(a(1) & a(2)) \ Val(b(1) & b(2))
   
      
        
  jss = MbC(Trim(jcc), D2)
   For i1 = 1 To Y
    jws = jws & a(i1)
      Next
      
      Do While MBJC(Trim(jws), Trim(jss)) = -1
      jcc = jcc - 1
      jss = MbC(Trim(jcc), D2)
      Loop
  JW = MPC(Trim(jws), Trim(jss))
  
    z = x - Y
   
    Dim c() As String
    ReDim c(1 To z)
    For s = 1 To z
     If MBJC(JW & a(s + Y), D2) = -1 Then
       c(s) = "0"
       Else
     jwc = Val(Left(JW & a(s + Y), 3)) \ Val(Left(D2, 2))
      If Len(jwc) > 1 Then
      c(s) = "9"
       Else
        c(s) = jwc
         End If
      
     Do While MBJC(JW & a(s + Y), MbC(Val(c(s)), D2)) = -1
    c(s) = Right(10000 + Val(c(s) - 1), 1)
     Loop
     End If
   
     JW = MPC(JW & a(s + Y), MbC(Val(c(s)), D2))
     
    jcc = jcc & c(s)
    Next s
    If JW = 0 Then
    MCC1 = jcc
    Else
    MCC1 = jcc & "/" & JW
    End If
   
  For I = 1 To Len(MCC1)
    If Not Mid(MCC1, I, 1) = "0" Then
        Exit For
    End If
Next
strTmp = Mid(MCC1, I)
  If Len(strTmp) = 0 Then
  MCC1 = "0"
  Else
MCC1 = strTmp
End If
   
   
   
    End If
   
   
   
   
   
  
  End If
End If
End If
End Function
   
   
   
    Public Function MCC(D1 As String, D2 As String) As String ';除数少于8位的除法
If Len(D1) < Len(D2) Then
   MCC = "0" & "/" & D1
   Else
   If Len(D1) < 9 Then
    MCC = Val(D1) \ Val(D2) & "/" & Val(D1) - (Val(D1) \ Val(D2)) * Val(D2)
     If Mid(MCC, InStr(MCC, "/") + 1) = 0 Then
  MCC = Left(MCC, InStr(MCC, "/") - 1)
Else
MCC = MCC
End If
   
    Else
   
   Dim x ';fen duan changdu
   x = Len(D1)
   
     
   
     Dim a() As String
      ReDim a(1 To x)  ';定义数组的储存空间
      For I = 1 To x Step 1  ';把被除数各位放在a()中
       a(I) = Mid(D1, I, 1)
        
      
       Next I
      Dim b() As String
      JW = 0
     ReDim b(1 To x)
     For J = 1 To x Step 1
    b(J) = Val(JW & a(J)) \ Val(D2)
      JW = Val(JW & a(J)) - Val(b(J)) * Val(D2)
       Next J
       For r = 1 To x
       If JW = 0 Then
          MCC = MCC & b(r)
          Else
          CJ = CJ & b(r)
          MCC = CJ & "/" & JW
      
    End If
   
    For I = 1 To Len(MCC)
   If Not Mid(MCC, I, 1) = "0" Then
       Exit For
   End If
Next
strTmp = Mid(MCC, I)
If Len(strTmp) = 0 Then
MCC = "0"
Else
MCC = strTmp
End If
   
   Next
   
   End If
     
     End If
   
End Function

   
   
   
    Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
  Dim x, Y '两数长度

If Len(D1) >= Len(D2) Then
  d4 = String(Len(D1) - Len(D2), "0") & D2
  d3 = D1
  Else
  d4 = D2
  d3 = String(Len(D2) - Len(D1), "0") & D1
  End If
  x = Len(d3): Y = Len(d4)
  Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
  ReDim a(1 To x)
  ReDim B1(1 To Y)
  ReDim C1(1 To x)
  ReDim E1(1 To x)
  Dim I, J, C2, CJ, JW
  For J = Y To 1 Step -1 'D2
  JW = 0 '进位清0
  B1(J) = Mid$(d4, J, 1) '每位数
For I = x To 1 Step -1  'D1
     a(I) = Mid$(d3, I, 1) '每位数
   C1(I) = a(I) + B1(I) + JW '计算jia
     JW = C1(I) \ 10
     E1(I) = C1(I) Mod 10
    Next
    Next
    For r = 1 To x
    If JW = 0 Then
    MPC1 = MPC1 & E1(r)
    Else
    jc = jc & E1(r)
    MPC1 = JW & jc
    End If
    Next
   
  End Function

  Public Function MBJC(D1 As String, D2 As String) As String ';bijiao
  If Len(D1) <= 10 And Len(D2) <= 10 Then
  If Val(D1) > Val(D2) Then
  MBJC = 1
  Else
  If Val(D1) = Val(D2) Then
  MBJC = 0
  Else
  MBJC = -1
  End If
  End If
  Else

  If Len(D1) > Len(D2) Then
  MBJC = 1
  Else
  If Len(D1) < Len(D2) Then
  MBJC = -1
  Else
  If Len(D1) = Len(D2) Then
  Dim x, Y
  x = Len(D1) \ 4: Y = Len(D2) \ 4
  Dim a() As String, b() As String
  ReDim a(4 To 4 * x + 4)
  ReDim b(4 To 4 * Y + 4)
  If Val(Left(D1, Len(D1) - 4 * x)) > Val(Left(D2, Len(D2) - 4 * Y)) Then
     MBJC = 1
     Else
     If Val(Left(D1, Len(D1) - 4 * x)) < Val(Left(D2, Len(D2) - 4 * Y)) Then
     MBJC = -1
     Else
     For I = 4 To 4 * x Step 4
     a(I) = Mid(D1, Len(D1) - I + 1, 4)
     b(I) = Mid(D2, Len(D2) - I + 1, 4)
     Next
     J = 4 * x
     Do While a(J) = b(J) And J >= 8
     
     J = J - 4
        Loop
        
        
      If Val(a(J)) - Val(b(J)) > 0 Then
      MBJC = 1
      Else
      If Val(a(J)) - Val(b(J)) < 0 Then
      MBJC = -1
      Else
      MBJC = 0
      End If
      
     End If
     
     
     
  End If
  End If
  End If
  End If
  End If
  End If
  End Function


[此贴子已经被作者于2021-3-26 11:39编辑过]

#250
ysr28572021-03-25 02:21
秦九韶算法:把一个一元n次多项式改写成秦九韶多项式,求多项式的值时,首先计算最内层括号内一次多项式的值,然后由内向外逐层计算一次多项式的值,这样,求n次多项式f(x)的值就转化为求n个一次多项式的值。上述方法称为秦九韶算法。直到今天,这种算法仍是多项式求值比较先进的算法。

可见老祖宗留下的方法还是好的,珍贵的有用的,在当时是先进的!

反复提取公因子后,原函数可以写成秦九韶多项式,可以用来加快计算速度。

对于一个n次的多项式函数,用常规方法(用重复乘法计算幂,再把各项相加)计算出结果最多需要n次加法和[n*(n+1)]/2次乘法。若用x迭代的方法计算幂则需要n次加法和2n+1次乘法。如果计算中的数值数据是以字节方式储存的,那么常规方法约需要x占用的字节的2n倍空间。

而使用秦九韶算法时,至多只需作n次加法和n次乘法,最多需要x占用的字节的n倍空间。

该算法看似简单,其最大的意义在于将求n次多项式的值转化为求n个一次多项式的值。在人工计算时,利用秦九韶算法和其中的系数表可以大幅简化运算;对于计算机程序算法而言,加法比乘法的计算效率要高很多,因此该算法仍有极大的意义,用于减少CPU运算时间。

该算法看似简单,其最大的意义在于将求n次多项式的值转化为求n个一次多项式的值。在人工计算时,利用秦九韶算法和其中的系数表可以大幅简化运算;对于计算机程序算法而言,加法比乘法的计算效率要高很多,因此该算法仍有极大的意义,对于计算机来说,做一次乘法运算所用的时间比作一次加法运算要长得多,所以此算法极大地缩短了CPU运算时间。
#251
ysr28572021-03-25 06:04
Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
  Dim x, Y, jw '两数长度

If Len(D1) >= Len(D2) Then
  d4 = String(Len(D1) - Len(D2), "0") & D2
  d3 = D1
  Else
  d4 = D2
  d3 = String(Len(D2) - Len(D1), "0") & D1
  End If
  x = Len(d3) \ 8: Y = Len(d4) \ 8
  If 8 * x < Len(d3) Then
  d3 = String(8 * x + 8 - Len(d3), "0") & d3
  d4 = String(8 * Y + 8 - Len(d4), "0") & d4
  x = x + 1: Y = Y + 1
  Else
  x = x: Y = Y
  d3 = d3: d4 = d4
  End If
  Dim a() As String, B1() As String, C1() As String, E1() As String
  ReDim a(1 To x)
  ReDim B1(1 To Y)
  ReDim C1(1 To x)
  ReDim E1(1 To x)
  Dim I, J, C2, CJ
  For J = Y To 1 Step -1 'D2
  jw = 0 '进位清0
  B1(J) = Mid$(d4, J * 8 - 7, 8) '每位数
For I = x To 1 Step -1  'D1
     a(I) = Mid$(d3, I * 8 - 7, 8) '每位数
   C1(I) = Val(a(I)) + Val(B1(I)) + Val(jw) '计算jia
   If Len(C1(I)) < 8 Then
   C1(I) = String(8 - Len(C1(I)), "0") & C1(I)
   Else
   C1(I) = C1(I)
   End If
     jw = Left(C1(I), Len(C1(I)) - 8)
     E1(I) = Right(C1(I), 8)
    Next
    Next
    For r = 1 To x
    If jw = 0 Then
    MPC1 = MPC1 & E1(r)
    Else
    jc = jc & E1(r)
    MPC1 = jw & jc
    End If
    Next
   MPC1 = qqdl(Trim(MPC1))
  End Function

Public Function MPC(D1 As String, D2 As String) As String ';jianfaqi
  Dim x, Y ';两数长度
  If qqdl(D2) = "0" Then
  MPC = D1
  Else
If Len(D1) >= Len(D2) Then
  d4 = String(Len(D1) - Len(D2), "0") & D2
  d3 = D1
  Else
  d4 = D2
  d3 = String(Len(D2) - Len(D1), "0") & D1
  End If
  x = Len(d3) \ 8: Y = Len(d4) \ 8
  d3 = String(8 * x + 8 - Len(d3), "0") & d3
  d4 = String(8 * Y + 8 - Len(d4), "0") & d4
  x = x + 1: Y = Y + 1
  
  Dim a() As String, B1() As String, C1() As String, E1() As String
  ReDim a(1 To x)
  ReDim B1(1 To Y)
  ReDim C1(1 To x)
  ReDim E1(1 To x)
  Dim I, J, C2, CJ, jw
  For J = Y To 1 Step -1 ';D2
  jw = 1 ';yu jie weichuzhi
  B1(J) = Mid(d4, J * 8 - 7, 8) ';每位数
For I = x To 1 Step -1  ';D1
     a(I) = Mid(d3, I * 8 - 7, 8) ';每位数
   C1(I) = Val(1 & a(I)) - Val(B1(I)) - Val(1) + Val(jw) ';计算jia
   If Len(C1(I)) <= 8 Then
   jw = 0
   C1(I) = String(8 - Len(C1(I)), "0") & C1(I)
   Else
     jw = Left(C1(I), Len(C1(I)) - 8)
     End If
     E1(I) = Right(C1(I), 8)
     If Len(E1(I)) < 8 Then
     E1(I) = String(8 - Len(E1(I)), "0") & E1(I)
     Else
     E1(I) = E1(I)
     End If
     
    Next
    Next
    For r = 1 To x
    MPC = MPC & E1(r)
    If Len(MPC) > Len(D1) Then
    MPC = Mid(MPC, Len(MPC) - Len(D1) + 1)
    Else
    MPC = MPC
    End If
    For I = 1 To Len(MPC)
      If Not Mid(MPC, I, 1) = "0" Then
          Exit For
      End If
  Next
  strTmp = Mid(MPC, I)
    If Len(strTmp) = 0 Then
    MPC = "0"
    Else
  MPC = strTmp
  End If
    Next
   End If
   
  End Function


Private Function qqdl(sa As String) As String

  
  For I = 1 To Len(sa)
    If Not Mid(sa, I, 1) = "0" Then
        Exit For
    End If
Next
strTmp = Mid(sa, I)
  If Len(strTmp) = 0 Then
  qqdl = "0"
  Else
qqdl = strTmp
 End If
End Function


[此贴子已经被作者于2021-4-2 23:44编辑过]

123456789