;---------------------------------------------------
	; Copyright Karl-Uwe Frank
	;
	; I place this source code into Public Domain
	;
	
	;---------------------------------------------------
	; http://rosettacode.org/wiki/Entropy#PureBasic
	;
	NewMap uchar.i() : Define.d e
	 
	Procedure.d nlog2(x.d) : ProcedureReturn Log(x)/Log(2) : EndProcedure
	 
	Procedure countchar(s$, Map uchar())
	  If Len(s$)
	    uchar(Left(s$,1))=CountString(s$,Left(s$,1))
	    s$=RemoveString(s$,Left(s$,1))
	    ProcedureReturn countchar(s$, uchar())
	  EndIf
	EndProcedure
	 
	
	;---------------------------------------------------
	; Draw some random byte and store them as text sting
	;
	#RNDvalByte = 160
	*RNDval = AllocateMemory(#RNDvalByte)
	
	RandomData(*RNDval, #RNDvalByte)  
	
	Define.s key
	For i = 0 To #RNDvalByte-1
		key + LCase(RSet(Hex(PeekB(*RNDval+i), #PB_Byte), 2, "0"))
	Next i     
	
	;---------------------------------------------------
	; Now check the entropy of this text string
	;
	ClearMap(uchar())
	countchar(key, uchar())
	 
	ForEach uchar()  
	  e-uchar()/Len(key)*nlog2(uchar()/Len(key))  
	Next
		
	Define.s info_string
	info_string + key +#CRLF$+#CRLF$
	info_string + "Entropy = "+StrD(e,15)
	
	;---------------------------------------------------
	; Convert the text string back to hex values
	;
	Define.s key_hex
	
	For i = 0 To Len(key)-1
		key_hex + Chr(Val("$"+Mid(key, (i*2)+1, 2)))
	Next
	
	;---------------------------------------------------
	; Compare the entropy of this hex string
	;
	FreeMap(uchar())
	NewMap uchar.i()
	e = 0
	countchar(key_hex, uchar())
	
	ForEach uchar()  
	  e-uchar()/Len(key_hex)*nlog2(uchar()/Len(key_hex))  
	Next

	Define.s info_hex
	
	For i = 0 To (Len(key)/2)-2
		info_hex + Mid(key, (i*2)+1, 2) +":"
	Next
	
	info_hex + Mid(key, (i*2)+1, 2) +#CRLF$+#CRLF$
	info_hex + "Entropy = "+StrD(e,15)
	
	;---------------------------------------------------
	; Show info in a Window
	;
	If OpenWindow(0, 100, 200, 600, 400, "Entropy Check", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) = 0
	  MessageRequester("Error", "Can't open Window", 0)
	  End
	EndIf		
	
	FrameGadget(0, 10,  10, 580, 180, "Text String to check:")
	FrameGadget(1, 10, 210, 580, 180, "Hex String to check:")

 	TextGadget( 2, 20,  30, 560, 170, info_string)
 	TextGadget( 3, 20, 230, 560, 170, info_hex)
 	
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow

	End 0