#! /usr/local/bin/rebol
REBOL [
	Title: "Ocorrência de dígitos"
	Purpose: {
	Mostrar o perfil de ocorrências de dígitos decimais
	no texto copiado para o clipboard.
	}
	Date:	2004-04-10
	File:	%frequencia-de-digitos-2004-04-09b.r
	Name:	'Ocorrencia-de-digitos
	Version: 1.0.0
	Home: http://www.meiradarocha.jor.br
	Author:	"José Antonio Meira da Rocha"
	Owner:	"Meira da Rocha e Associados"
	Rights:	"Copyright (C) José Antonio Meira da Rocha 2004"
	Needs:	[
		%Hof.r
	]
	Tabs:	4
	Note:	{
		Funcionando OK. http://meiradarocha.jor.br/uploads/images/341/frequencia-de-digitos-2006-09-15b.r
	}
	History:	[
	1.0.0 [2004-04-15 "Publicado o programa" "meira"]
	]
	Language:	'Portuguese
]


;------------------------------------------------
;	Funções MAX-BLOCK e MIN-BLOCK
;------------------------------------------------
; Copyright	http://www.reboltech.com/library/scripts/hof.r

foldl: func [
    {Fold left operation:
        ((a -+ b -+ a) -+ a -+ [b] -+ a)
    }
    f [any-function!]
    x [any-type!]
    ys [series!]
    /local result [any-type!]
][
    result: x
    while [not tail? ys][
        result: f result first ys
        ys: next ys
    ]
    result
]


require: func [
    {Throws an error if any 'precondition' is violated,
    otherwise returns 'true'. Used for preconditions validation.
        ([[logic]] -+ logic)
    }
    [throw]
    preconditions [block!]
    /local result [logic!]
][
    foreach p preconditions [
        if not (do p) [
            throw make error! (join "Violated precondition " (mold p))
        ]
    ]
    result: true
    result
]



foldl1: func [
    {As foldl but with the first alement of the series 'ys
    serving as the starting point. The series ys should
    not be empty.
        (a -+ a -+ a) -+ [a] -+ a)
    }
    f [any-function!]  {a -> a -> a}
    ys [series!]  {[a]}
    /local result [any-type!]
][
    require [[not empty? ys]]
    result: foldl :f (first ys) (next ys)
    result
]

max-block: func [
    {Returns maximum value from a block
        ([a] -> a}
    xs [block!] {[a]}
    /local result [any-type!]
][
    result: foldl1 :max xs
    result
]

min-block: func [
    {Returns maximum value from a block
    min-block :: [a] -> a
    }
    xs [block!] {[a]}
    /local result [any-type!]
][
    result: foldl1 :min xs
    result
]

;--------------------------------------------------
; Quanto: calcula quantos digitos existem num texto
;--------------------------------------------------
quantos: func [
	 	{Retorna a quantidade de vezes que um pedaço de texto
	 ocorre em um texto}
	pedaco {Pedaço a ser contado.}
 	texto	{Texto que pode conter o pedaço.}
 	/local contador
][
	contador: 0
	while [
		texto: find/tail texto pedaco
	][
		contador: contador + 1
	]
	contador
]

;-------------------------------------------
; Soma o bloco de valores para achar o valor
; correspondente a 100%
;-------------------------------------------
soma-bloco: func [
	{Soma todos os números de um bloco.}
	bloco "Bloco de valores"
	/local valor total
][
	total: 0
	if error? try [
		foreach valor bloco [
			total: total + valor
		]
	][
		alert { Não há números suficientes na memória.
			Tente copiar bastantes valores.
		}
		return
	]
	total	 ; retorna o valor total
]

;--------------------------------------------
; percentiza
;--------------------------------------------
percentiza: func [
	{Transforma um bloco de números em percentuais
	 relativos à soma total dos números do bloco.
	 Devolve um bloco com percentuais arrendondados
	 em dois dígitos decimais }
	b {bloco a ser percentizado}
	/local total v	x res
][
	res: copy []
	total: soma-bloco b
	foreach v b [
		either v <> 0 [
			x: 100 * v
			x: x / total
			x: round/to x 0.01
			insert tail res x
		][
			insert tail res 0
		]
	]
	res
]

;--------------------------------------------
; Define o tamanho da barra conforme a escala
;--------------------------------------------
barra: func [
	{Calcula as dimensões das barras}
	ocorrencias {Número de ocorrências de dígito}
	maximo		{Maior percentagem de ocorrências}
	/local
	altura-da-barra escala largura-da-tela
	altura-da-tela largura-maxima temp
][
	altura-da-barra: 16
	escala: 4	;Ajuste aqui a largura das barras
	largura-da-tela: system/view/screen-face/size/x
	altura-da-tela: system/view/screen-face/size/y
	largura-maxima: largura-da-tela / escala
	temp: ocorrencias * largura-maxima
	temp: temp / maximo
	temp: to-pair to-integer temp
	temp/y: altura-da-barra
	temp
]

;---------------------------------------
;
; Lê o clipboard e enumera ocorrências
;
;---------------------------------------
le-memoria: does [
	na-memoria: copy read/lines clipboard://
	quantidade-de-zero:		quantos "0" na-memoria
	quantidade-de-um:		quantos "1" na-memoria
	quantidade-de-dois:		quantos "2" na-memoria
	quantidade-de-tres:		quantos "3" na-memoria
	quantidade-de-quatro:	quantos "4" na-memoria
	quantidade-de-cinco:	quantos "5" na-memoria
	quantidade-de-seis:		quantos "6" na-memoria
	quantidade-de-sete:		quantos "7" na-memoria
	quantidade-de-oito:		quantos "8" na-memoria
	quantidade-de-nove:		quantos "9" na-memoria
]

;--------------------------------------------
; Cria bloco com quantidade de digitos
;--------------------------------------------
calcula-quantidade-de-digitos: does [
	quantidade-de-digitos:	to-block reform [
		quantidade-de-zero
		quantidade-de-um
		quantidade-de-dois
		quantidade-de-tres
		quantidade-de-quatro
		quantidade-de-cinco
		quantidade-de-seis
		quantidade-de-sete
		quantidade-de-oito
		quantidade-de-nove
	]

]

;------------------------------------------------
; Calcula percentual das ocorrências na memória
;------------------------------------------------
calcula-percentual: does [
	percentuais-de-digitos: percentiza quantidade-de-digitos

	percentual-de-zero:		to-string pick percentuais-de-digitos 1
	percentual-de-um:		to-string pick percentuais-de-digitos 2
	percentual-de-dois:		to-string pick percentuais-de-digitos 3
	percentual-de-tres:		to-string pick percentuais-de-digitos 4
	percentual-de-quatro:	to-string pick percentuais-de-digitos 5
	percentual-de-cinco:	to-string pick percentuais-de-digitos 6
	percentual-de-seis:		to-string pick percentuais-de-digitos 7
	percentual-de-sete:		to-string pick percentuais-de-digitos 8
	percentual-de-oito:		to-string pick percentuais-de-digitos 9
	percentual-de-nove:		to-string pick percentuais-de-digitos 10
]

;---------------------------------------------------
; Calcula maior porcentagem de ocorrências, que será
; usada como maior largura das barras.
;---------------------------------------------------
calcula-maximo: does [
	maximo-memoria: max-block percentuais-de-digitos
	maximo-google:	max-block	percentuais-google
	maximo-benford: 30.1	 ;valor constante
	percent-maximo: max maximo-memoria maximo-google
	percent-maximo: max percent-maximo maximo-benford
]

;--------------------------------------------------------
; Calcula dimensões das barras das ocorrências na memória
;--------------------------------------------------------
escala-barra: does [
	tam-barra-do-zero:	 barra	pick percentuais-de-digitos 1 percent-maximo
	tam-barra-do-um:	 barra	pick percentuais-de-digitos 2 percent-maximo
	tam-barra-do-dois:	 barra	pick percentuais-de-digitos 3 percent-maximo
	tam-barra-do-tres:	 barra	pick percentuais-de-digitos 4 percent-maximo
	tam-barra-do-quatro: barra	pick percentuais-de-digitos 5 percent-maximo
	tam-barra-do-cinco:	 barra	pick percentuais-de-digitos 6 percent-maximo
	tam-barra-do-seis:	 barra	pick percentuais-de-digitos 7 percent-maximo
	tam-barra-do-sete:	 barra	pick percentuais-de-digitos 8 percent-maximo
	tam-barra-do-oito:	 barra	pick percentuais-de-digitos 9 percent-maximo
	tam-barra-do-nove:	 barra	pick percentuais-de-digitos 10 percent-maximo
]

;------------------------------------------------
; Valores base do Google
; Resultado da procura por algarismos,
; menos 1'000'000 para arredondar
;------------------------------------------------
digitos-google: [
		871
		1860
		1510
		1190
		993
		883
		705
		622
		610
		537
]

percentuais-google: percentiza digitos-google

percentual-google: does [
	google-zero:	to-string pick percentuais-google 1
	google-um:		to-string pick percentuais-google 2
	google-dois:	to-string pick percentuais-google 3
	google-tres:	to-string pick percentuais-google 4
	google-quatro: 	to-string pick percentuais-google 5
	google-cinco:	to-string pick percentuais-google 6
	google-seis:	to-string pick percentuais-google 7
	google-sete:	to-string pick percentuais-google 8
	google-oito:	to-string pick percentuais-google 9
	google-nove:	to-string pick percentuais-google 10
]

escala-google: does [
	tam-google-zero: 	barra	pick percentuais-google 1 percent-maximo
	tam-google-um:	 	barra	pick percentuais-google 2 percent-maximo
	tam-google-dois: 	barra	pick percentuais-google 3 percent-maximo
	tam-google-tres: 	barra	pick percentuais-google 4 percent-maximo
	tam-google-quatro: 	barra	pick percentuais-google 5 percent-maximo
	tam-google-cinco: 	barra	pick percentuais-google 6 percent-maximo
	tam-google-seis: 	barra	pick percentuais-google 7 percent-maximo
	tam-google-sete:	barra	pick percentuais-google 8 percent-maximo
	tam-google-oito: 	barra	pick percentuais-google 9 percent-maximo
	tam-google-nove:	barra	pick percentuais-google 10 percent-maximo
]

;------------------------------------------------
; Números de benford
;------------------------------------------------
digitos-benford: [
	7.91 	;hacking: Benford não usa 0. Repeti o valor do 5
	30.1
	17.6
	12.49
	9.69
	7.91
	6.69
	5.79
	5.11
	4.57
]

percentuais-benford: percentiza digitos-benford

percentual-benford: does [
	benford-zero:	to-string pick percentuais-benford 1
	benford-um:		to-string pick percentuais-benford 2
	benford-dois:	to-string pick percentuais-benford 3
	benford-tres:	to-string pick percentuais-benford 4
	benford-quatro: to-string pick percentuais-benford 5
	benford-cinco:	to-string pick percentuais-benford 6
	benford-seis:	to-string pick percentuais-benford 7
	benford-sete:	to-string pick percentuais-benford 8
	benford-oito:	to-string pick percentuais-benford 9
	benford-nove:	to-string pick percentuais-benford 10
]
escala-benford: does [
	tam-benford-zero:	barra	pick percentuais-benford 1 percent-maximo
	tam-benford-um:		barra	pick percentuais-benford 2 percent-maximo
	tam-benford-dois:	barra	pick percentuais-benford 3 percent-maximo
	tam-benford-tres:	barra	pick percentuais-benford 4 percent-maximo
	tam-benford-quatro: barra	pick percentuais-benford 5 percent-maximo
	tam-benford-cinco:	barra	pick percentuais-benford 6 percent-maximo
	tam-benford-seis:	barra	pick percentuais-benford 7 percent-maximo
	tam-benford-sete:	barra	pick percentuais-benford 8 percent-maximo
	tam-benford-oito:	barra	pick percentuais-benford 9 percent-maximo
	tam-benford-nove:	barra	pick percentuais-benford 10 percent-maximo
]

;------------------------------------------------
; Calcula o tamanho das barras e percentuais
;------------------------------------------------
calcula-barras: does [
	le-memoria
	calcula-quantidade-de-digitos
	calcula-percentual
	calcula-maximo
	escala-barra
]
calcula-referencias: does [
	percentual-google
	escala-google
	percentual-benford
	escala-benford
]

;------------------------------------------------
; Grava a imagem do painel do gráfico
;------------------------------------------------
save-image: does [
	hora: now
	nome-do-arquivo: to-file rejoin [
		"digitos-"
		hora/year "-"
		hora/month "-"
		hora/day "-"
		hora/time/hour
		hora/time/minute
		to-integer hora/time/second
		".png"]
	save/png nome-do-arquivo to-image grafico
]

;------------------------------------------
; Realiza os cálculos iniciais
;------------------------------------------
calcula-barras
calcula-referencias

;------------------------------------------------
; Painel do gráfico
;------------------------------------------------
monta-grafico: does [
	grafico: layout [
		origin 8
		;Formatação do texto e gráfico
		style rotulo	h4		16x16 right
		style percent	text 	55 right blue
		style pgoogle	text 	50 right red
		style pbenford	text 	50 right 0.128.0
		style caixa		box		0.151.255 1x16
		style google	box		edge [size: 1x1 color: red]
		style benford	box		edge [size: 2x2 color: 102.192.102]
		space 2x2

		return
		h2 "Porcentagem de ocorrência de dígitos"
		field 450
		across
	rotulo ""
		percent "Memória"
		pgoogle "Google"
		pbenford "Benford"
		return
	rotulo "0"
		percent	percentual-de-zero
		pgoogle google-zero
		pbenford benford-zero
		here: at
		caixa tam-barra-do-zero
		at here benford tam-benford-zero
		at here google tam-google-zero
		return
	rotulo "1"
		percent	percentual-de-um
		pgoogle google-um
		pbenford benford-um
		here: at
		caixa tam-barra-do-um
		at here benford tam-benford-um
		at here google tam-google-um
		return
	rotulo "2"
		percent	percentual-de-dois
		pgoogle google-dois
		pbenford benford-dois
		here: at
		caixa tam-barra-do-dois
		at here benford tam-benford-dois
		at here google tam-google-dois
		return
	rotulo "3"
		percent	percentual-de-tres
		pgoogle google-tres
		pbenford benford-tres
		here: at
		caixa tam-barra-do-tres
		at here benford tam-benford-tres
		at here google tam-google-tres
		return
	rotulo "4"
		percent	percentual-de-quatro
		pgoogle google-quatro
		pbenford benford-quatro
		here: at
		caixa tam-barra-do-quatro
		at here benford tam-benford-quatro
		at here google tam-google-quatro
		return
	rotulo "5"
		percent	percentual-de-cinco
		pgoogle google-cinco
		pbenford benford-cinco
		here: at
		caixa tam-barra-do-cinco
		at here benford tam-benford-cinco
		at here google tam-google-cinco
		return
	rotulo "6"
		percent	percentual-de-seis
		pgoogle google-seis
		pbenford benford-seis
		here: at
		caixa tam-barra-do-seis
		at here benford tam-benford-seis
		at here google tam-google-seis
		return
	rotulo "7"
		percent	percentual-de-sete
		pgoogle google-sete
		pbenford benford-sete
		here: at
		caixa tam-barra-do-sete
		at here benford tam-benford-sete
		at here google tam-google-sete
		return
	rotulo "8"
		percent	percentual-de-oito
		pgoogle google-oito
		pbenford benford-oito
		here: at
		caixa tam-barra-do-oito
		at here benford tam-benford-oito
		at here google tam-google-oito
		return
	rotulo "9"
		percent	percentual-de-nove
		pgoogle google-nove
		pbenford benford-nove
		here: at
		caixa tam-barra-do-nove
		at here benford tam-benford-nove
		at here google tam-google-nove
		space 16x16
		pad 0x16
		return
	]
	grafico/offset: 0x0
]

;-----------------------------------------------
; Painel principal
;-----------------------------------------------
monta-grafico
principal: layout [
	across
	painel: box grafico/size + 4  edge [size: 1x1 color: black]
	return
	btn "Calcula" [
		calcula-barras
		monta-grafico
		painel/pane: grafico
		show painel
	]
	btn "Grava imagem" 152.204.255 [save-image]
	btn "Fecha" 255.204.204 [Quit]
]
;------------------------------------------
; Apresenta o layout centralizado na tela
;------------------------------------------
view center-face principal