RosettaCodeData/Task/Benfords-law/PureBasic/benfords-law.basic

41 lines
936 B
Plaintext

#MAX_N=1000
NewMap d1.i()
Dim fi.s(#MAX_N)
fi(0)="0" : fi(1)="1"
Declare.s Sigma(sx.s,sy.s)
For I=2 To #MAX_N
fi(I)=Sigma(fi(I-2),fi(I-1))
Next
For I=1 To #MAX_N
d1(Left(fi(I),1))+1
Next
Procedure.s Sigma(sx.s, sy.s)
Define i.i, v1.i, v2.i, r.i
Define s.s, sa.s
sy=ReverseString(sy) : s=ReverseString(sx)
For i=1 To Len(s)*Bool(Len(s)>Len(sy))+Len(sy)*Bool(Len(sy)>=Len(s))
v1=Val(Mid(s,i,1))
v2=Val(Mid(sy,i,1))
r+v1+v2
sa+Str(r%10)
r/10
Next i
If r : sa+Str(r%10) : EndIf
ProcedureReturn ReverseString(sa)
EndProcedure
OpenConsole("Benford's law: Fibonacci sequence 1.."+Str(#MAX_N))
Print(~"Dig.\t\tCnt."+~"\t\tExp.\t\tDif.\n\n")
ForEach d1()
Print(RSet(MapKey(d1()),4," ")+~"\t:\t"+RSet(Str(d1()),3," ")+~"\t\t")
ex=Int(#MAX_N*Log(1+1/Val(MapKey(d1())))/Log(10))
PrintN(RSet(Str(ex),3," ")+~"\t\t"+RSet(StrF((ex-d1())*100/ex,5),8," ")+" %")
Next
PrintN(~"\nPress Enter...")
Input()