PureBasic Forums - English

Code: Select all

Procedure.s BigPowOld(Num.s, pow.l)

    Answer.s = Num
 
    If pow = 1 ;
        Answer = num
    Else
        For i = 1 To pow - 1
            Answer = BigMultiply(Num, Answer )   
        Next
    EndIf
    
    ProcedureReturn Answer

EndProcedure

Code: Select all

Procedure.s BigPow(Num.s, pow.l)

    If pow = 1 ;
        ProcedureReturn num
    ElseIf pow = 2
        ProcedureReturn BigMultiply(Num, Num)
    ElseIf pow = 3
        ProcedureReturn BigMultiply(Num, BigPow(Num,2))
    Else  
        If pow % 2 = 0
            ProcedureReturn BigMultiply(BigPow(Num,pow / 2), BigPow(Num,pow / 2))  
        Else
            ProcedureReturn BigMultiply(BigMultiply(BigPow(Num,pow / 2), BigPow(Num,pow / 2)),num)  
        EndIf
    EndIf
    
EndProcedure

Code: Select all

; Define VNF - Vogels Number Format

	#VNFDim=10000; ~90000 Ciphers ;)

	Structure VNF
		len.w
		sign.w
		num.l[#VNFDim]
	EndStructure

	; Signs
	#VNFNegative=-1
	#VNFPositive=0

	; Dimensions
	#VNFLen=9
	#VNFMod=1000000000

	Declare.s Number(*num.VNF);					String
	Declare PutNumber(*s.s,*num.VNF);			s -> num
	Declare VNFMuW(*a.VNF,b.l,*c.VNF);			c = a*b, |b|<10^10
	Declare VNFAdd(*a.VNF,*b.VNF,*c.VNF);  	c = a+b

; EndDefine

Procedure.s Number(*num.VNF)

	Protected n
	Protected t.s

	If *num\sign
		t="-"
	EndIf

	n=*num\len
	t+Str(*num\num[n])

	While n>0
		n-1
		t+RSet(Str(*num\num[n]),#VNFLen,"0")
	Wend


	ProcedureReturn t

EndProcedure
Procedure GetNumber(*s.String,*num.VNF)

	; ACHTUNG! s ist bei dieser Routine vom Typ String!
	; (bei x.string bedeutet dies den Aufruf "GetNumber(x,number)" und die Ausgabe "Debug x\s")

	Protected n
	Protected t.s

	If *num\sign
		t="-"
	EndIf

	n=*num\len
	t+Str(*num\num[n])

	While n>0
		n-1
		t+RSet(Str(*num\num[n]),#VNFLen,"0")
	Wend

	*s\s=t

EndProcedure
Procedure PutNumber(*s.s,*num.VNF)

	Protected n,p
	Protected t.s

	*num\sign=0

	t=PeekS(@*s)
	n=Len(t)-#VNFLen

	While n>0
		*num\num[p]=Val(PeekS(@t+n,#VNFLen))
		p+1
		n-#VNFLen
	Wend

	n=Val(PeekS(@t,9+n))
	If n<0
		*num\sign=#VNFNegative
		n=-n
	EndIf

	*num\num[p]=n

	*num\len=p

EndProcedure

Procedure VNFMuW(*a.VNF,b,*c.VNF)

	Protected n
	Protected m.q

	n=*a\len

	If b=0
		*c\len=0
		*c\sign=#VNFPositive
		*c\num[0]=0
	Else

		If b<0
			b=-b
			*c\sign=#VNFNegative-*a\sign
		Else
			*c\sign=*a\sign
		EndIf

		n=0
		Repeat
			m+*a\num[n] * b
			*c\num[n]=m%#VNFMod
			m/#VNFMod

			n+1
		Until n>*a\len

		If m
			*c\num[n]=m
		Else
			n-1
		EndIf
		*c\len=n

	EndIf

EndProcedure
Procedure VNFAdd(*a.VNF,*b.VNF,*c.VNF)

	Protected n
	Protected s

	*c\sign=*a\sign

	If *a\len<*b\len
		Swap *a,*b
	EndIf

	While n<=*a\len
		s+*a\num[n]
		If n<=*b\len
			s+*b\num[n]
		EndIf
		*c\num[n]=s%#VNFMod
		s/#VNFMod
		n+1
	Wend
	If s
		*c\num[n]=s
	Else
		n-1
	EndIf

	*c\len=n

EndProcedure


an.VNF
sn.VNF
s.s="0"
PutNumber(@s,sn)

For i=1 To 1000
	PutNumber(@"1",an)
	For j=1 To i
		VNFMuW(an,i,an)
	Next j
	VNFAdd(an,sn,sn)
Next i

s=Number(sn)

MessageRequester(Right(s,10),s)

Code: Select all

Procedure.s Permutation(String$, n)
  
  Protected i, Factorial = 1, Temp
  
  For i = 2 To Len(String$)
    Factorial * (i - 1)
    Temp = PeekB(@String$ + (i - ((n / Factorial) % i) - 1))
    PokeB(@String$ + (i - ((n / Factorial) % i) - 1), PeekB(@String$ + i - 1))
    PokeB(@String$ + i - 1, Temp)
  Next
  
  ProcedureReturn String$
  
EndProcedure

MyString$ = "ABC"

i = 1
Repeat
  Permutation$ = Permutation(MyString$, i)
  Debug Permutation$
  i + 1
Until Permutation$ = MyString$

Code: Select all

Procedure Problem_154(n)

	#size=2000
	#mid=#size>>1
	minx=#mid
	miny=#mid
	maxx=#mid
	maxy=#mid

	#modulo=1000000000000

	Dim A.q(#size,#size);	(x+y+z)^n | n=0, 3, 6, ...
	Dim B.q(#size,#size);	(x+y+z)^n | n=1, 4, 7, ...
	Dim C.q(#size,#size);	(x+y+z)^n | n=2, 5, 8, ...

	#maxwerte=#size*#mid
	Dim werte.q(#maxwerte)
	Dim anzahl(#maxwerte)

	level=1
	B(#mid,#mid)=1

	Repeat

		level+1
		Select level%3

		Case 0
			maxx+1
			miny-1
			For x=minx To maxx
				For y=miny To maxy
					A(x,y)=(C(x-1,y+1)+C(x,y)+C(x,y+1));%#modulo
			
				Next y
			Next x

		Case 1
			minx-1
			miny+1
			maxy+2
			
			For x=minx To maxx
				For y=miny To maxy
					B(x,y)=(A(x,y-1)+A(x+1,y-2)+A(x+1,y-1));%#modulo
				Next y
			Next x

		Case 2
			maxx+1
			miny-1
			
			For x=minx To maxx
				For y=miny To maxy
					C(x,y)=(B(x,y+1)+B(x,y)+B(x-1,y+1));%#modulo
				Next y
			Next x
		EndSelect

	Until level=n


	found=0
	For i=0 To #maxwerte
		werte(i)=0
		anzahl(i)=0
	Next i

	l=level%3
	For x=minx To maxx
		For y=miny To maxy
			Select l
			Case 0
				d=A(x,y)
			Case 1
				d=B(x,y)
			Case 2
				d=C(x,y)
			EndSelect
			If d

				i=found
				While i
					If werte(i)=d
						Break
					Else
						i-1
					EndIf
				Wend
				If i
					anzahl(i)+1
				Else
					found+1
					werte(found)=d
					anzahl(found)+1
				EndIf

			EndIf

		Next y
	Next x

	For i=1 To found
		Debug StrQ(werte(i))+" x "+Str(anzahl(i))
	Next i
EndProcedure

Problem_154(5)

Code: Select all

#modulo=100000

f=1
n=10
n=20
n=100000

While n
	a=n%#modulo
	If a
		f*a
		While f%10=0
			f=f/10
		Wend
		f%#modulo
	EndIf
	n-1
Wend

MessageRequester("...",Str(f))