Why does not function FACT()

Message

Eugene Lutsenko · #1 Post by **Eugene Lutsenko** » Tue Jun 04, 2013 1:17 am

Can anyone tell me, why does not work function, which calculates the value of the factorial.
Moreover, as:

MsgBox(STR(FACT(10)))

works, and where it is necessary (in the calculation of the number of combinations) does not work:

***************************************************************
********* С(n,m) = n! / (m! (n - m)!) число сочетаний из n по m
***************************************************************
FUNCTION Cl(n,m)
RETURN(INT(FACT(n)/(FACT(m)*FACT(n-m))))

It may be useful to someone: a function for calculating the number of combinations of large numbers without using the factorial (which can not have an argument more than 170):

Code: Select all

********************************************************************************************
*** (C) Расчет числа сочетаний для больших чисел без промежуточного расчета факториалов
***     путем разложения их на простые множители и сокращения, beta-version, rel: 04.06.2013
*** (C) д.э.н., к.т.н., профессор Луценко Евгений Вениаминович, Россия, Краснодар.
********************************************************************************************

#include "appevent.ch"
#include "axcdxcmx.ch"
#include "collat.ch"
#include "common.ch"
#include "dbedit.ch"
#include "dbfdbe.ch"
#include "dcapp.ch"
#include "dcbitmap.ch"
#include "dccargo.ch"
#include "dccursor.ch"
#include "dcdialog.ch"
#include "dcdir.ch"
#include "dcfiles.ch"
#include "dcgra.ch"
#include "dcgraph.ch"        // графика
#include "BdColors.Ch"       // графика
#include "dccolors.ch"       // графика
#include "dcprint.ch"        // графика
*#INCLUDE "rmchart.CH"       // графика
#include "dcicon.ch"
#include "dcmsg.ch"
#include "dcpick.ch"
#include "deldbe.ch"
#include "directry.ch"
#include "dmlb.ch"
#include "express.ch"
#include "fileio.ch"
#include "font.ch"
#include "gra.ch"
#include "inkey.ch"
#include "memvar.ch"
#include "natmsg.ch"
#include "prompt.ch"
#include '_dcdbfil.ch'
*#INCLUDE "dcads.CH"
#include "set.ch"
#include "std.ch"
#include "xbp.ch"
#include '_dcappe.ch'
#include 'dcscope.ch'
#include '_dcstru.ch'
#include 'dcfields.ch'
#include 'dccolor.ch'

#pragma library( "ascom10.lib" )
#pragma library( "dclip1.lib" )
#pragma library( "dclip2.lib" )
#pragma library( "dclipx.lib" )
#pragma library( "xbtbase1.lib" )
#pragma library( "xbtbase2.lib" )
#pragma library( "xppui2.lib" )

PROCEDURE AppSys
// Рабочий стол остается окном приложения
RETURN

********************************************************************************
FUNCTION Main()

LOCAL  GetList[0], GetOptions, nColor, oMessageBox, oMenuWords, oDlg, ;
       oMenuBar,oMenu1,oMenu2,oMenu3,oMenu4,oMenu5,oMenu6,oMenu7,;
       oMenu3_3

DC_IconDefault(1000)

   SET DECIMALS TO 15
   SET DATE GERMAN
   SET ESCAPE On

   SET COLLATION TO SYSTEM   // Руссификация
   *SET COLLATION TO ASCII   // Руссификация

   PUBLIC aSay[30], Mess97, Mess98, Mess99           // Массив сообщений отображаемых стадий исполнения (до 30 на экране)
   PUBLIC Time_progress, Wsego, oProgress, lOk
   PUBLIC nEvery := 100                              // Количество корректировок прогресс-бар

***********************************************************************************************************************
   g = 0
   s = 0
   mRegim = 1
   @g  , 0 DCGROUP oGroup1 CAPTION 'Задайте вариант использования программы:' SIZE 62.0, 7.0
   @++s, 2 DCRADIO mRegim VALUE 1 PROMPT 'Расчет одного конкретного значения числа сочетаний из N по M' PARENT oGroup1
   @++s, 2 DCRADIO mRegim VALUE 2 PROMPT 'Расчет таблицы значений числа сочетаний для диапазонов N и M' PARENT oGroup1

   s  =  3
   mN1 = 30
   mM1 =  2
   @++s+0.2,12 DCSAY "Задайте значение N:"        EDITPROTECT {||.NOT.mRegim=1} HIDE {||.NOT.mRegim=1} PARENT oGroup1
   @  s    ,27 DCSAY "" GET mN1 PICTURE "#######" EDITPROTECT {||.NOT.mRegim=1} HIDE {||.NOT.mRegim=1} PARENT oGroup1
   @++s+0.2,12 DCSAY "Задайте значение M:"        EDITPROTECT {||.NOT.mRegim=1} HIDE {||.NOT.mRegim=1} PARENT oGroup1
   @  s    ,27 DCSAY "" GET mM1 PICTURE "#######" EDITPROTECT {||.NOT.mRegim=1} HIDE {||.NOT.mRegim=1} PARENT oGroup1

   s  =  3
   N1 =  1
   N2 = 30
   M1 =  1
   M2 = N2
   @++s+0.2, 5 DCSAY "Задайте диапазон значений N:" EDITPROTECT {||.NOT.mRegim=2} HIDE {||.NOT.mRegim=2} PARENT oGroup1
   @  s    ,27 DCSAY "" GET N1 PICTURE "#######"    EDITPROTECT {||.NOT.mRegim=2} HIDE {||.NOT.mRegim=2} PARENT oGroup1
   @  s    ,37 DCSAY "" GET N2 PICTURE "#######"    EDITPROTECT {||.NOT.mRegim=2} HIDE {||.NOT.mRegim=2} PARENT oGroup1
   @++s+0.2, 5 DCSAY "Задайте диапазон значений M:" EDITPROTECT {||.NOT.mRegim=2} HIDE {||.NOT.mRegim=2} PARENT oGroup1
   @  s    ,27 DCSAY "" GET M1 PICTURE "#######"    EDITPROTECT {||.NOT.mRegim=2} HIDE {||.NOT.mRegim=2} PARENT oGroup1
   @  s    ,37 DCSAY "" GET M2 PICTURE "#######"    EDITPROTECT {||.NOT.mRegim=2} HIDE {||.NOT.mRegim=2} PARENT oGroup1

   DCGETOPTIONS TABSTOP
   DCREAD GUI ;
      FIT ;
      OPTIONS GetOptions ;
      ADDBUTTONS;
      MODAL ;
      TITLE '(C) Луценко Е.В. Расчет сочетаний для больших чисел'
***********************************************************************************************************************

IF mRegim = 1
   oScr := DC_WaitOn()
   Mess := {}
   IF mN1 < 171
      AADD(Mess, "Число сочетаний из N=# по M=$ по классической формуле с факториалами: С(n,m) = n! / ( m! ( n-m )! ) = "+ALLTRIM(STR(INT(Cl(mN1,mM1)))))
   ELSE
      AADD(Mess, "Число сочетаний из N=# по M=$ по формуле с факториалами: С(n,m)=n!/(m!(n-m)!) не может быть рассчитано !")
   ENDIF
   AADD(Mess, "Число сочетаний из N=# по M=$ по алгоритму с сокр.простых множителей: С(n,m) = P(m+1,n)/P(1,n-m) = "+ALLTRIM(STR(INT(C(mN1,mM1)))))
   AADD(Mess, "где: P(a,b)=a*(a+1)*(a+2)*...*b: произведение целых чисел от a до b с шагом 1")
   DC_Impl(oScr)
   Mess[1] = STRTRAN(Mess[1], "#", ALLTRIM(STR(mN1,15)))
   Mess[1] = STRTRAN(Mess[1], "$", ALLTRIM(STR(mM1,15)))
   Mess[2] = STRTRAN(Mess[2], "#", ALLTRIM(STR(mN1,15)))
   Mess[2] = STRTRAN(Mess[2], "$", ALLTRIM(STR(mM1,15)))
   LB_Warning(Mess, "(C) Луценко Е.В. Расчет числа сочетаний для больших чисел" )
ENDIF

***********************************************************************************************************************

IF mRegim = 2

   aStructure := { { "N", "C", 15, 0} }
   FOR j=N1 TO N2
       FieldName = "M"+ALLTRIM(STR(j,21))
       AADD(aStructure, { FieldName, "C", 250, 0 })
   NEXT
   DbCreate( "Cnm.dbf" , aStructure )

   Mess = 'Расчет числа сочетаний из n по m'
   @ 4,5 DCPROGRESS oProgress SIZE 70,1.1 MAXCOUNT RecCount() COLOR GRA_CLR_CYAN PERCENT EVERY 100
   DCREAD GUI TITLE Mess PARENT @oDialog FIT EXIT
   oDialog:show()
   nMax  = 0;FOR mn=N1 TO N2;FOR mm=1 TO mn;++nMax;NEXT;NEXT
   nTime = 0

   CLOSE ALL
   USE Cnm  EXCLUSIVE NEW
   SELECT Cnm

   DC_GetProgress(oProgress,0,nMax)
   FOR mn = N1 TO N2
       APPEND BLANK
       FIELDPUT(1, "N"+ALLTRIM(STR(mn,21)))
       FOR mm = 1 TO mn
           FIELDPUT(1+mm, ALLTRIM(STR(C(mn,mm),250)))
           DC_GetProgress(oProgress, ++nTime, nMax)
       NEXT
   NEXT
   DC_GetProgress(oProgress,nMax,nMax)
   oDialog:Destroy()

   Mess := {}
   AADD(Mess, 'Результаты расчета числа сочетаний C(n,m) в базе данных Cnm.dbf')
   AADD(Mess, 'Из-за большой размерности числа в БД Cnm.dbf представлены в текстовом формате')
   AADD(Mess, 'Заданием в MS Excel формата ячеек "числовой" они преобразутся в числовой формат')
   LB_Warning(Mess, "(C) Луценко Е.В. Расчет числа сочетаний для больших чисел")

ENDIF

CLOSE ALL
RETURN NIL

************************************************************************
******** Факториал *****************************************************
******** Для больших чисел использовать приближенную формулу Стирлинга
************************************************************************
FUNCTION F(kn)
IF kn < 171
   kF=1
   FOR kz=1 TO kn
       kF=kF*kz
   NEXT
ELSE
*  // формула Муавра-Стирлинга ускоряет (приближенные) расчеты для больших чисел, но не решает саму проблему больших чисел
   kp = 3.14159265358979323846
   ke = 2.71828182845904523536
   kF=SQRT(2*kp*kn)*(kn^kn)*ke^(-kn)*(1+1/(12*kn)+1/(288*kn^2)-139/(51840*kn^3)-571/(2488320*kn^4)+163879/(209018880*kn^5)+5246819/(75246796800*kn^6))
ENDIF
RETURN(kF)

***************************************************************
********* С(n,m) = n! / (m! (n - m)!) число сочетаний из n по m
***************************************************************
FUNCTION Cl(cn,cm)
RETURN(F(cn)/(F(cm)*F(cn-cm)))

**************************************************************************
******** С(n,m) = n! / (m! (n - m)!) число сочетаний из n по m для больших
******** чисел без вычисления промежуточных факториалов путем разложения 
******** факториалов на простые множители и их сокращений
******** С(n,m) = P(m+1,n) / P(1,n-m), где P(a,b) произведение целых чисел от a до b с шагом 1
**************************************************************************
******** 1. Найти все простые числа меньшие n
******** 2. Сформировать массив чисел числителя
******** 3. Сформировать массив простых сомножителей числителя
******** 4. Сформировать массив чисел знаменателя
******** 5. Сформировать массив простых сомножителей чисел знаменателя
******** 6. Сформировать массив простых сомножителей числителя,
********    не входящих в массив простых сомножителей знаменателя
******** 7. Перемножить массив уникальных простых сомножителей числителя
**************************************************************************
FUNCTION C(n,m)

   ***** 1. Найти все простые числа меньшие n, включая 1 и допуская n=1
   aPrCh := {}   // Массив простых чисел
   IF n = 1
      AADD(aPrCh, 1)
   ELSE
      FOR j = 2 TO n
          **** Проверка, является ли j простым числом
          Flag = .T.
          FOR i=2 TO j-1
              IF j=i*INT(j/i)  // Делится ли j на i нацело?
                 Flag = .F.
                 EXIT
              ENDIF
          NEXT
          IF Flag
             AADD(aPrCh, j)
          ENDIF
      NEXT
   ENDIF
*  DC_DebugQout( aPrCh )

   ***** 2. Сформировать массив чисел числителя
   aChis := {}
   IF m = n
      AADD(aChis, 1)
   ELSE
      IF m < n
         FOR j=m+1 TO n
             AADD(aChis, j)
         NEXT
      ENDIF
   ENDIF
*  DC_DebugQout( aChis )

   ******* 3. Сформировать массив простых сомножителей числителя
   aPSChis := {}
   FOR i=1 TO LEN(aChis)

       ***** Разложить число на простые множители
       aPrMn := {}   // Массив простых множителей числа: Chislo
       Chislo = aChis[i]
       IF Chislo = 1
          AADD(aPrMn,1)
       ELSE
          Flag = .T.
          DO WHILE Flag
             FOR j=1 TO LEN(aPrCh)
                 **** Проверка, делится ли Chislo на простое число из массива aPrCh
                 Flag = .F.
                 IF Chislo = aPrCh[j] * INT(Chislo/aPrCh[j])
                    AADD(aPrMn,aPrCh[j])
                    Chislo = Chislo/aPrCh[j]
                    Flag = .T.
                    EXIT
                 ENDIF
             NEXT
          ENDDO
       ENDIF
       
       ***** Занести простые множители числа aChis[j] в массив простых сомножителей числителя
       FOR j=1 TO LEN(aPrMn)
           AADD(aPSChis, aPrMn[j])
       NEXT

   NEXT
*  DC_DebugQout( aPSChis )

   ***** 4. Сформировать массив чисел знаменателя
   aZnam := {}
   IF m = n
      AADD(aZnam, 1)
   ELSE
      IF m < n
         FOR j=1 TO n - m
             AADD(aZnam, j)
         NEXT
      ENDIF
   ENDIF
*  DC_DebugQout( aZnam )

   ******* 5. Сформировать массив простых сомножителей чисел знаменателя
   aPSZnam := {}
   FOR i=1 TO LEN(aZnam)

       ***** Разложить число на простые множители
       aPrMn := {}   // Массив простых множителей числа: Chislo
       Chislo = aZnam[i]
       IF Chislo = 1
          AADD(aPrMn,1)
       ELSE
          Flag = .T.
          DO WHILE Flag
             FOR j=1 TO LEN(aPrCh)
                 **** Проверка, делится ли Chislo на простое число из массива aPrCh
                 Flag = .F.
                 IF Chislo = aPrCh[j] * INT(Chislo/aPrCh[j])
                    AADD(aPrMn,aPrCh[j])
                    Chislo = Chislo/aPrCh[j]
                    Flag = .T.
                    EXIT
                 ENDIF
             NEXT
          ENDDO
       ENDIF

       *** Занести простые множители числа aZnam[j] в массив простых сомножителей знаменателя
       FOR j=1 TO LEN(aPrMn)
           AADD(aPSZnam, aPrMn[j])
       NEXT

   NEXT
*  DC_DebugQout( aPSZnam )

   ******** 6. Сформировать массив простых сомножителей числителя,
   ********    не входящих в массив простых сомножителей знаменателя
   aPS:= {}
   FOR j=1 TO LEN(aPSChis)
       Pos = ASCAN(aPSZnam, aPSChis[j])
       IF Pos = 0
          AADD(aPS, aPSChis[j])
       ELSE
          aPSZnam[Pos] = 1    // Сокращение простых сомножителей числителя и знаменателя
       ENDIF
   NEXT
*  DC_DebugQout( aPS )

   ******** 7. Перемножить массив уникальных простых сомножителей числителя и знаменателя
   mMulChis = 1
   FOR j=1 TO LEN(aPS)
       mMulChis = mMulChis * aPS[j]
   NEXT
   mMulZnam = 1
   FOR j=1 TO LEN(aPSZnam)
       mMulZnam = mMulZnam * aPSZnam[j]
   NEXT
*  DC_DebugQout( mMulChis, mMulZnam, mMulChis/mMulZnam )

RETURN(mMulChis/mMulZnam)

******************************************
FUNCTION LB_Warning( message, ctitle )

  LOCAL aMsg := {}
  DEFAULT cTitle TO ''
  IF valtype(message) # 'A'
    aadd(aMsg,message)
  ELSE
    aMsg := message
  ENDIF
  IF LEN(ALLTRIM(cTitle)) > 0
     DC_MsgBox( ,,aMsg,cTitle)
  ELSE
     DC_MsgBox( ,,aMsg,'Универсальная когнитивная аналитическая система "Эйдос-Х++"')
  ENDIF

RETURN NIL

[/size]

#2 Post by **rdonnay** » Tue Jun 04, 2013 7:38 am

How do you know that it doesn't work?

Is your algorthim correct? С(n,m) = n! / (m! (n - m)!)

You code seems to satisfy the algorithm: FUNCTION Cl(n,m) ; RETURN(INT(FACT(n)/(FACT(m)*FACT(n-m))))

What value are you expecting for a particular set of n, m ?

Eugene Lutsenko · #3 Post by **Eugene Lutsenko** » Tue Jun 04, 2013 9:10 am

I expect the value of the number of combinations, which is obtained in the MS Exel using the "number of combinations." What strangely: design offers: Msgbox(STR(FACT(10))) is working properly. In here when you substitute FACT() in the formula for the number of combinations - get 0.

#4 Post by **rdonnay** » Tue Jun 04, 2013 10:21 am

What values are you passing to the function CL() ?

Eugene Lutsenko · #5 Post by **Eugene Lutsenko** » Tue Jun 04, 2013 11:39 am

Well, for example, when n = 30, m = 3:

the code provides:

Code: Select all

************************************************************************
******** Факториал *****************************************************
******** Для больших чисел использовать приближенную формулу Стирлинга
************************************************************************
FUNCTION F(kn)
IF kn < 171
   kF=1
   FOR kz=1 TO kn
       kF=kF*kz
   NEXT
ELSE
*  // формула Муавра-Стирлинга ускоряет (приближенные) расчеты для больших чисел, но не решает саму проблему больших чисел
   kp = 3.14159265358979323846
   ke = 2.71828182845904523536
   kF=SQRT(2*kp*kn)*(kn^kn)*ke^(-kn)*(1+1/(12*kn)+1/(288*kn^2)-139/(51840*kn^3)-571/(2488320*kn^4)+163879/(209018880*kn^5)+5246819/(75246796800*kn^6))
ENDIF
RETURN(kF)

***************************************************************
********* С(n,m) = n! / (m! (n - m)!) число сочетаний из n по m
***************************************************************
FUNCTION Cl(cn,cm)
RETURN(F(cn)/(F(cm)*F(cn-cm)))

Then the code:

Code: Select all

***************************************************************
********* С(n,m) = n! / (m! (n - m)!) число сочетаний из n по m
***************************************************************
FUNCTION Cl(cn,cm)
RETURN(Fact(cn)/(Fact(cm)*Fact(cn-cm)))

for the same parameters leads to the following result:

#6 Post by **rdonnay** » Tue Jun 04, 2013 12:49 pm

Your answer is very confusing and verbose.

I want to know what values you are passing to Fact() and what value you expect in return.

Eugene Lutsenko · #7 Post by **Eugene Lutsenko** » Wed Jun 05, 2013 6:09 am

Roger! You gave me an idea that will solve this problem: I realized what was happening. Just function Fact() does not allow to calculate factorial numbers more than 21, and in this example, required 30! For numbers, <=21, everything works fine. All the more necessary that I made, that is function calculating the number of combinations without the intermediate calculation of factorials.

Here is the original text of the well-functioning of the program calculate the number of combinations without using the factorial, and executable module and configured it in a database formats DBF and XLS in the calculation of C (n, m) where n={1-250} and m={1-250}. All this can be downloaded here: http://lc.kubagro.ru/Install_Aidos-X/Cnm.rar

Code: Select all

********************************************************************************************
*** (C) Расчет числа сочетаний для больших чисел без промежуточного расчета факториалов
***     путем разложения их на простые множители и сокращения, beta-version, rel: 05.06.2013
*** (C) д.э.н., к.т.н., профессор Луценко Евгений Вениаминович, Россия, Краснодар.
********************************************************************************************

#include "appevent.ch"
#include "axcdxcmx.ch"
#include "collat.ch"
#include "common.ch"
#include "dbedit.ch"
#include "dbfdbe.ch"
#include "dcapp.ch"
#include "dcbitmap.ch"
#include "dccargo.ch"
#include "dccursor.ch"
#include "dcdialog.ch"
#include "dcdir.ch"
#include "dcfiles.ch"
#include "dcgra.ch"
#include "dcgraph.ch"        // графика
#include "BdColors.Ch"       // графика
#include "dccolors.ch"       // графика
#include "dcprint.ch"        // графика
*#INCLUDE "rmchart.CH"       // графика
#include "dcicon.ch"
#include "dcmsg.ch"
#include "dcpick.ch"
#include "deldbe.ch"
#include "directry.ch"
#include "dmlb.ch"
#include "express.ch"
#include "fileio.ch"
#include "font.ch"
#include "gra.ch"
#include "inkey.ch"
#include "memvar.ch"
#include "natmsg.ch"
#include "prompt.ch"
#include '_dcdbfil.ch'
*#INCLUDE "dcads.CH"
#include "set.ch"
#include "std.ch"
#include "xbp.ch"
#include '_dcappe.ch'
#include 'dcscope.ch'
#include '_dcstru.ch'
#include 'dcfields.ch'
#include 'dccolor.ch'

#pragma library( "ascom10.lib" )
#pragma library( "dclip1.lib" )
#pragma library( "dclip2.lib" )
#pragma library( "dclipx.lib" )
#pragma library( "xbtbase1.lib" )
#pragma library( "xbtbase2.lib" )
#pragma library( "xppui2.lib" )

PROCEDURE AppSys
// Рабочий стол остается окном приложения
RETURN

********************************************************************************
FUNCTION Main()

LOCAL  GetList[0], GetOptions, nColor, oMessageBox, oMenuWords, oDlg, ;
       oMenuBar,oMenu1,oMenu2,oMenu3,oMenu4,oMenu5,oMenu6,oMenu7,;
       oMenu3_3

DC_IconDefault(1000)

   SET DECIMALS TO 15
   SET DATE GERMAN
   SET ESCAPE On

   SET COLLATION TO SYSTEM   // Руссификация
   *SET COLLATION TO ASCII   // Руссификация

   PUBLIC aSay[30], Mess97, Mess98, Mess99           // Массив сообщений отображаемых стадий исполнения (до 30 на экране)
   PUBLIC Time_progress, Wsego, oProgress, lOk
   PUBLIC nEvery := 100                              // Количество корректировок прогресс-бар

***********************************************************************************************************************
   g = 0
   s = 0
   mRegim = 1
   @g  , 0 DCGROUP oGroup1 CAPTION 'Задайте вариант использования программы:' SIZE 62.0, 7.0
   @++s, 2 DCRADIO mRegim VALUE 1 PROMPT 'Расчет одного конкретного значения числа сочетаний из N по M' PARENT oGroup1
   @++s, 2 DCRADIO mRegim VALUE 2 PROMPT 'Расчет таблицы значений числа сочетаний для диапазонов N и M' PARENT oGroup1

   s  =  3
   mN1 = 30
   mM1 =  2
   @++s+0.2,12 DCSAY "Задайте значение N:"        EDITPROTECT {||.NOT.mRegim=1} HIDE {||.NOT.mRegim=1} PARENT oGroup1
   @  s    ,27 DCSAY "" GET mN1 PICTURE "#######" EDITPROTECT {||.NOT.mRegim=1} HIDE {||.NOT.mRegim=1} PARENT oGroup1
   @++s+0.2,12 DCSAY "Задайте значение M:"        EDITPROTECT {||.NOT.mRegim=1} HIDE {||.NOT.mRegim=1} PARENT oGroup1
   @  s    ,27 DCSAY "" GET mM1 PICTURE "#######" EDITPROTECT {||.NOT.mRegim=1} HIDE {||.NOT.mRegim=1} PARENT oGroup1

   s  =  3
   N1 =  1
   N2 = 30
   M1 =  1
   M2 = N2
   @++s+0.2, 5 DCSAY "Задайте диапазон значений N:" EDITPROTECT {||.NOT.mRegim=2} HIDE {||.NOT.mRegim=2} PARENT oGroup1
   @  s    ,27 DCSAY "" GET N1 PICTURE "#######"    EDITPROTECT {||.NOT.mRegim=2} HIDE {||.NOT.mRegim=2} PARENT oGroup1
   @  s    ,37 DCSAY "" GET N2 PICTURE "#######"    EDITPROTECT {||.NOT.mRegim=2} HIDE {||.NOT.mRegim=2} PARENT oGroup1
   @++s+0.2, 5 DCSAY "Задайте диапазон значений M:" EDITPROTECT {||.NOT.mRegim=2} HIDE {||.NOT.mRegim=2} PARENT oGroup1
   @  s    ,27 DCSAY "" GET M1 PICTURE "#######"    EDITPROTECT {||.NOT.mRegim=2} HIDE {||.NOT.mRegim=2} PARENT oGroup1
   @  s    ,37 DCSAY "" GET M2 PICTURE "#######"    EDITPROTECT {||.NOT.mRegim=2} HIDE {||.NOT.mRegim=2} PARENT oGroup1

   DCGETOPTIONS TABSTOP
   DCREAD GUI ;
      FIT ;
      OPTIONS GetOptions ;
      ADDBUTTONS;
      MODAL ;
      TITLE '(C) Луценко Е.В. Расчет сочетаний для больших чисел'
***********************************************************************************************************************

IF mRegim = 1

   oScr := DC_WaitOn()
   Mess := {}
   IF mN1 <= 21
      AADD(Mess, "Число сочетаний из N=# по M=$ по классической формуле с факториалами: С(n,m) = n! / ( m! ( n-m )! ) = "+ALLTRIM(STR(INT(Cf(mN1,mM1)))))
   ELSE
      AADD(Mess, "Число сочетаний из N=# по M=$ по формуле с факториалами: С(n,m)=n!/(m!(n-m)!) не может быть рассчитано !")
   ENDIF
   AADD(Mess, "Число сочетаний из N=# по M=$ по алгоритму с сокр.простых множителей: С(n,m) = P(m+1,n)/P(1,n-m) = "+ALLTRIM(STR(INT(C(mN1,mM1)))))
   AADD(Mess, "где: P(a,b)=a*(a+1)*(a+2)*...*b: произведение целых чисел от a до b с шагом 1")
   DC_Impl(oScr)
   Mess[1] = STRTRAN(Mess[1], "#", ALLTRIM(STR(mN1,15)))
   Mess[1] = STRTRAN(Mess[1], "$", ALLTRIM(STR(mM1,15)))
   Mess[2] = STRTRAN(Mess[2], "#", ALLTRIM(STR(mN1,15)))
   Mess[2] = STRTRAN(Mess[2], "$", ALLTRIM(STR(mM1,15)))
   LB_Warning(Mess, "(C) Луценко Е.В. Расчет числа сочетаний для больших чисел" )
ENDIF

***********************************************************************************************************************

IF mRegim = 2

   aStructure := { { "N", "C", 15, 0} }
   FOR j=N1 TO N2
       FieldName = "M"+ALLTRIM(STR(j,21))
       AADD(aStructure, { FieldName, "C", 250, 0 })
   NEXT
   DbCreate( "Cnm.dbf" , aStructure )

   Mess = 'Расчет числа сочетаний из n по m'
   @ 4,5 DCPROGRESS oProgress SIZE 70,1.1 MAXCOUNT RecCount() COLOR GRA_CLR_CYAN PERCENT EVERY 100
   DCREAD GUI TITLE Mess PARENT @oDialog FIT EXIT
   oDialog:show()
   nMax  = 0;FOR mn=N1 TO N2;FOR mm=1 TO mn;++nMax;NEXT;NEXT
   nTime = 0

   CLOSE ALL
   USE Cnm  EXCLUSIVE NEW
   SELECT Cnm

   DC_GetProgress(oProgress,0,nMax)
   FOR mn = N1 TO N2
       APPEND BLANK
       FIELDPUT(1, "N"+ALLTRIM(STR(mn,21)))
       FOR mm = 1 TO mn
           FIELDPUT(1+mm, ALLTRIM(STR(C(mn,mm),250)))
           DC_GetProgress(oProgress, ++nTime, nMax)
       NEXT
   NEXT
   DC_GetProgress(oProgress,nMax,nMax)
   oDialog:Destroy()

   Mess := {}
   AADD(Mess, 'Результаты расчета числа сочетаний C(n,m) в базе данных Cnm.dbf')
   AADD(Mess, 'Из-за большой размерности числа в БД Cnm.dbf представлены в текстовом формате')
   AADD(Mess, 'Заданием в MS Excel формата ячеек "числовой" они преобразутся в числовой формат')
   LB_Warning(Mess, "(C) Луценко Е.В. Расчет числа сочетаний для больших чисел")

ENDIF

CLOSE ALL
RETURN NIL

***************************************************************
********* С(n,m) = n! / (m! (n - m)!) число сочетаний из n по m
***************************************************************
FUNCTION Cf(n,m)
RETURN(Fact(n)/(Fact(m)*Fact(n-m)))

**************************************************************************
******** С(n,m) = n! / (m! (n - m)!) число сочетаний из n по m для больших
******** чисел без вычисления промежуточных факториалов путем разложения 
******** факториалов на простые множители и их сокращений
******** С(n,m) = P(m+1,n) / P(1,n-m), где P(a,b) произведение целых чисел от a до b с шагом 1
**************************************************************************
******** 1. Найти все простые числа меньшие n
******** 2. Сформировать массив чисел числителя
******** 3. Сформировать массив простых сомножителей числителя
******** 4. Сформировать массив чисел знаменателя
******** 5. Сформировать массив простых сомножителей чисел знаменателя
******** 6. Сформировать массив простых сомножителей числителя,
********    не входящих в массив простых сомножителей знаменателя
******** 7. Перемножить массив уникальных простых сомножителей числителя
**************************************************************************
FUNCTION C(n,m)

   ***** 1. Найти все простые числа меньшие n, включая 1 и допуская n=1
   aPrCh := {}   // Массив простых чисел
   IF n = 1
      AADD(aPrCh, 1)
   ELSE
      FOR j = 2 TO n
          **** Проверка, является ли j простым числом
          Flag = .T.
          FOR i=2 TO j-1
              IF j=i*INT(j/i)  // Делится ли j на i нацело?
                 Flag = .F.
                 EXIT
              ENDIF
          NEXT
          IF Flag
             AADD(aPrCh, j)
          ENDIF
      NEXT
   ENDIF
*  DC_DebugQout( aPrCh )

   ***** 2. Сформировать массив чисел числителя
   aChis := {}
   IF m = n
      AADD(aChis, 1)
   ELSE
      IF m < n
         FOR j=m+1 TO n
             AADD(aChis, j)
         NEXT
      ENDIF
   ENDIF
*  DC_DebugQout( aChis )

   ******* 3. Сформировать массив простых сомножителей числителя
   aPSChis := {}
   FOR i=1 TO LEN(aChis)

       ***** Разложить число на простые множители
       aPrMn := {}   // Массив простых множителей числа: Chislo
       Chislo = aChis[i]
       IF Chislo = 1
          AADD(aPrMn,1)
       ELSE
          Flag = .T.
          DO WHILE Flag
             FOR j=1 TO LEN(aPrCh)
                 **** Проверка, делится ли Chislo на простое число из массива aPrCh
                 Flag = .F.
                 IF Chislo = aPrCh[j] * INT(Chislo/aPrCh[j])
                    AADD(aPrMn,aPrCh[j])
                    Chislo = Chislo/aPrCh[j]
                    Flag = .T.
                    EXIT
                 ENDIF
             NEXT
          ENDDO
       ENDIF
       
       ***** Занести простые множители числа aChis[j] в массив простых сомножителей числителя
       FOR j=1 TO LEN(aPrMn)
           AADD(aPSChis, aPrMn[j])
       NEXT

   NEXT
*  DC_DebugQout( aPSChis )

   ***** 4. Сформировать массив чисел знаменателя
   aZnam := {}
   IF m = n
      AADD(aZnam, 1)
   ELSE
      IF m < n
         FOR j=1 TO n - m
             AADD(aZnam, j)
         NEXT
      ENDIF
   ENDIF
*  DC_DebugQout( aZnam )

   ******* 5. Сформировать массив простых сомножителей чисел знаменателя
   aPSZnam := {}
   FOR i=1 TO LEN(aZnam)

       ***** Разложить число на простые множители
       aPrMn := {}   // Массив простых множителей числа: Chislo
       Chislo = aZnam[i]
       IF Chislo = 1
          AADD(aPrMn,1)
       ELSE
          Flag = .T.
          DO WHILE Flag
             FOR j=1 TO LEN(aPrCh)
                 **** Проверка, делится ли Chislo на простое число из массива aPrCh
                 Flag = .F.
                 IF Chislo = aPrCh[j] * INT(Chislo/aPrCh[j])
                    AADD(aPrMn,aPrCh[j])
                    Chislo = Chislo/aPrCh[j]
                    Flag = .T.
                    EXIT
                 ENDIF
             NEXT
          ENDDO
       ENDIF

       *** Занести простые множители числа aZnam[j] в массив простых сомножителей знаменателя
       FOR j=1 TO LEN(aPrMn)
           AADD(aPSZnam, aPrMn[j])
       NEXT

   NEXT
*  DC_DebugQout( aPSZnam )

   ******** 6. Сформировать массив простых сомножителей числителя,
   ********    не входящих в массив простых сомножителей знаменателя
   aPS:= {}
   FOR j=1 TO LEN(aPSChis)
       Pos = ASCAN(aPSZnam, aPSChis[j])
       IF Pos = 0
          AADD(aPS, aPSChis[j])
       ELSE
          aPSZnam[Pos] = 1    // Сокращение простых сомножителей числителя и знаменателя
       ENDIF
   NEXT
*  DC_DebugQout( aPS )

   ******** 7. Перемножить массив уникальных простых сомножителей числителя и знаменателя
   mMulChis = 1
   FOR j=1 TO LEN(aPS)
       mMulChis = mMulChis * aPS[j]
   NEXT
   mMulZnam = 1
   FOR j=1 TO LEN(aPSZnam)
       mMulZnam = mMulZnam * aPSZnam[j]
   NEXT
*  DC_DebugQout( mMulChis, mMulZnam, mMulChis/mMulZnam )

RETURN(mMulChis/mMulZnam)

******************************************
FUNCTION LB_Warning( message, ctitle )

  LOCAL aMsg := {}
  DEFAULT cTitle TO ''
  IF valtype(message) # 'A'
    aadd(aMsg,message)
  ELSE
    aMsg := message
  ENDIF
  IF LEN(ALLTRIM(cTitle)) > 0
     DC_MsgBox( ,,aMsg,cTitle)
  ELSE
     DC_MsgBox( ,,aMsg,'Универсальная когнитивная аналитическая система "Эйдос-Х++"')
  ENDIF

RETURN NIL

[/size]

bb.donnay-software.com

Why does not function FACT()

Why does not function FACT()

Re: Why does not function FACT()

Re: Why does not function FACT()

Re: Why does not function FACT()

Re: Why does not function FACT()

Re: Why does not function FACT()

Re: Why does not function FACT()