Métodos computacionais / 2019

Davi C. Rodrigues
Aula 5

e-mail: davi@cosmo-ufes.org
página do curso: davi.cosmo-ufes.org/mc2019

Dois programas: um de análise de dados e outro analítico -- “Um capítulo” sem análogo no Paul Welling

Aplicação para análise de dados

Importação e preparação dos dados

Como exemplo, tratemos da tabela fornecida “TabelaMC2019.csv”

SetDirectory[NotebookDirectory[]]
data =Import["TabelaMC2019.csv"];

data // TableForm

É conveniente eliminar os comentários. 

Forma manual:

data1 = Drop[data,5];

data1[[1]]

O uso de “#” para demarcar comentários no início de uma tabela é bastante  comum. É conveniente criarmos uma função que sempre remova linhas que começam com “#”.

data[[1]]

Head@First@First@data

StringTake["# MAGMA - Mathematica Automatized Galaxy Mass Analysis (2017)",1]

StringTake[data[[1]],1]

ToString[2435.45]

StringTake["23452345234523452345.23452345",5]

StringTake[ToString[2435.45],1]

list = {(x^2), 1, (y^3)};
Position[list, x_,1]

StringTake[data[[1]],1]

If[
StringTake[First@data[[10]],1]=== "#" ,
"ok",
"not ok"]

pos = Position[data, n_ /; Quiet@StringTake[First@n,1]=== "#"]

data1a = Delete[data, pos];

data1a == data1

Construindo uma função

NoComments[data_] := 
Block[{pos},
pos = Position[data, n_ /; Quiet@StringTake[First@n,1]=== "#"];
Delete[data,pos]
];

NoComments[data] == data1a

test = NoComments[data];
data1 == test

NoComments[data_, symbol_] := 
Block[{pos},
pos = Position[data, n_ /; Quiet@StringTake[First@n,1]=== ToString[symbol]];
Delete[data,pos]
]

ToString["#"]

Exercício: fazer uma função em que a “string” usada para indicar comentários possa ser escolhida pelo usuário. Definir “#” como a string padrão de comentários.

Clear@NoComments;
NoComments[data_, symbol_:"#"] := 
Block[{pos},
pos = Position[data, n_ /; Quiet@StringTake[First@n,1]=== ToString[symbol]];
Delete[data,pos]
]

Cabeçalho

header = NoComments[data][[1]];
dataC = Drop[NoComments[data],1];

header

RandomReal[10,{10,2}]

{a,b,c,d, "asdf,adsf"}

ListPlot[RandomReal[10,{10,2}]]

ListPlot[dataC[[All, {3,4}]], PlotRange -> All]

Definia variáveis do tipo ColGalaxy, ColHtype...

aux = StringReplace[header, {" "->  "", "." -> "", "-" -> "", "_"-> ""}]

((#)^2)&[2 x]

aux2=ToExpression["col"<># &/@ aux]

Clear[a,b,c,j]
j = {a,b,c}
Evaluate[j]=Range[3]

a

FullForm[Hold[a=b]]

Attributes[Set]

{a,b,c} = Range[3]

a

b

c

aux2 = Range[Length[aux2]]

ClearOwnValues[x_] :=  Last[Map[Clear,First[OwnValues[x]], {2}]];
SetAttributes[ClearOwnValues, {HoldAll}]

Exercício: tente entender o código de ClearOwnValues.

ClearOwnValues[aux2];
Evaluate[aux2] = Range[Length[aux2]];

aux2

ListPlot[dataC[[All, {3,4}]]]

ListPlot[dataC[[All, {colD,coldeltaD}]]]

dataC[[All, colGalaxy]]

dataC[[All, {colD, colL}]]

Correlações

ListPlot@dataC[[All, {colL, colVflat}]]

ListPlot[dataC[[All, {colL, colReff}]], Frame -> True]

Plot[x,{x,-1,2}, Frame-> True, Axes-> False]

Histogram@dataC[[All,colL]]

Melhorando um pouco a aparência do Plot

ListPlot[dataC[[All, {colL, colReff}]], PlotTheme->"Detailed"]

Graphics[{Darker[Cyan,0.3],  Thickness-> .2, Circle[]}, ImageSize->12]

Graphics[{Black, Disk[]}, ImageSize->12]

colL

dataC[[All,{3,4}]]

Table[{dataC[[i,3]],Log10[2 (10^9) dataC[[i,4]]]}, {i,Length[dataC]}]

ListPlot[dataC[[All, {colL, colReff}]], PlotRange->All, Frame-> True, Axes -> False, PlotMarkers-> θ, GridLines->Automatic, GridLinesStyle-> Directive[Dashed, LightGray], AspectRatio->1]
ListPlot[dataC[[All, {colL, colReff}]], PlotRange->All, Frame-> True, Axes -> False, PlotMarkers->Graphics[{Black, Disk[]}, ImageSize->12], GridLines->Automatic, GridLinesStyle-> Directive[Dashed, LightGray], AspectRatio->1]

Applica “Log10[(10^9)# ]” em todos os elementos da primeira coluna, duas formas:

dataC[[All,{colL,colReff}]] /. {x_,y_} -> {x, f y};

corLReff = MapAt[Log10[(10^9)# ]&, dataC[[All, {colL, colReff}]],{All,1}];

ListPlot[corLReff, PlotRange->All, Frame-> True, Axes -> False, FrameStyle->14, PlotMarkers->Graphics[{Black,  Thickness-> .2, Circle[]}, ImageSize->12], GridLines->Automatic, GridLinesStyle-> Directive[Dashed, LightGray], AspectRatio->1]

Define subconjunto que satisfaz certo critério, critério que é baseado em outra coluna.

dataClowHI = Select[dataC, #[[colMHI]] < 1.0 &];
corLRefflowHI = MapAt[Log10[(10^9)# ]&, dataClowHI[[All, {colL, colReff}]],{All,1}]

ListPlot[{corLReff, corLRefflowHI}, PlotRange->All, Frame-> True, Axes -> False, FrameStyle->14, PlotMarkers->{Graphics[{Black,  Thickness-> .2, Circle[]}, ImageSize->12], Graphics[{Red,  Thickness-> .2, Circle[]}, ImageSize->12]}, GridLines->Automatic, GridLinesStyle-> Directive[Dashed, LightGray], AspectRatio->1]

Exercício: Defina uma função do tipo corrrelation[data, {col1, col2}, {f1, f2}], cujo resulado é uma lista de pares de números da matrix data gerados a partir de sua coluna 1 e coluna 2, mas em que as funções f1 e f2 foram respectiamente aplicadas à coluna 1 e à coluna 2. Ou seja, em particular correlation[data, {col1, col2}, {#&, #&}] == data[[All, {col1,col2}]], pois #& é uma função identidade.

Uma possível resposta:

correlation[data_,{col1_,col2_}, {f1_,f2_}] := Block[{tr1},
tr1=MapAt[f1,data[[All,{col1,col2}]],{All,1}];
MapAt[f2,tr1,{All,2}]
]

correlation[dataC,{colL,colReff},{Log10[(10^9) #]&, Sin[#]&}]

Exercício para nota!: Definia uma função semelhante à anterior, mas em que cada coluna resultante seja uma função de uma funcão arbitrária de quaisquer colunas da matriz data original. Não sei se esta é a melhor forma de entrada, mas pode-se especificar variáveis do tipo x1, x2.... e a função desejada poderia ser utilizada com  a seguinte sintaxe: CorrelationExt[data, {f1[x1, x5], f2[x4,x8]}] (aqui, x1, x2... não representam números, mas variávies que denotam nomes de colunas, sendo x1 a coluna 1, x2 a coluna 2...), ou, de forma amis explícita, CorrelationExt[data, {#3 + #5 &,  #4*#8 - #4&}],  Dessa forma, teremos, como caso particular, CorrelationExt[data, {x1, x8}] == data[[All, {1, 8}]].

Lembrete, que talvez seja útil:

((#1)^2) + #6&[2, 5,5,6,8,e,2]

Aplicação para manipulações analíticas

gMatrix = (({{A[r], 0, 0, 0}, {0, B[r], 0, 0}, {0, 0, (r^2), 0}, {0, 0, 0, (r^2) ((Sin[θ])^2)}}));

gMatrix[[1,1]]

g[a_,b_] := gMatrix[[a+1,b+1]]

g[0,0]

gI[a_,b_]:=Inverse[gMatrix][[a+1,b+1]]

gI[0,0]

Clear[g]

g

(Subscript[x, 1])=r;
(Subscript[x, 2])=θ;

A linha abaixo é suficinete para calcular o símbolo de Christofell.

Chr[k_,i_,j_] := 1/2 (∑_(m=0)^3)gI[k,m]((∂_(Subscript[x, j])) g[i,m] + (∂_(Subscript[x, i])) g[j,m] - (∂_(Subscript[x, m])) g[i,j])

Problema: é pouco eficiente na prática, pois há outros símbolos que dependem de várias componentes desse símbolo, assim ao escrever dessa foram acima, a mesma conta pode estar ser repetida centenas de vezes sem necessidade. Cada vez que Chr[1,1,2] é digitado, repete-se a conta acima. 

Uma forma muito simples de implementar memória dos resultados obtidos é usar o procedimento abaixo:

Chr[k_,i_,j_] := Chr[k,i,j]=1/2 (∑_(m=0)^3)gI[k,m]((∂_(Subscript[x, j])) g[i,m] + (∂_(Subscript[x, i])) g[j,m] - (∂_(Subscript[x, m])) g[i,j])

Agora, para cada conjunto de índices, Chr é computado uma única vez. Da vez seguinte apenas usa-se o valor salvo na definição. Desta forma, Chr é definido como uma função de i, j, k no termo mais à esquerda. E no termo seguinte, para dados valores de i, j e k (por exemplo, 1, 2 e 3), a expressão à direita é computada e atribuída à definição de Chr[1,2,3].

Chr[2,3,4] = 5

Chr[2,3,4]

Chr[1,2,3]

Chr[1,1,1]

Clear[k]

Segue um código básico e mal escrito, mas que funciona minimamente e que otimiza um pouco mais o calculo do símbolo de Christofell.

d=3;
Chr[k_,i_,j_] := 1/2 (∑_(m=0)^3)gI[k,m]((∂_(Subscript[x, j])) g[i,m] + (∂_(Subscript[x, i])) g[j,m] - (∂_(Subscript[x, m])) g[i,j]);
ChrEvaluate := Module[{},
	tempo = Timing[
		For[ i= 0, i<=d, i++, For[j=0, j<=d, j++, For[k=0, k<=d, k++, ChrE[k,i,j] = Chr[k,i,j]]]]; ];
	Print["Christofell symbols evaluation time:", tempo[[1]]];Print["Use ChrE[i,j,k] to call for each evaluated Chr."]]
ChrEvaluate := Module[{},
	tempo = Timing[
For[ i= 0, i<=d, i++, For[j=0, j<=d, j++, For[k=0, k<=d, k++, ChrE[k,i,j] = Chr[k,i,j]]]]; ];
	Print["Christofell symbols evaluation time:", tempo[[1]]];Print["Use ChrE[i,j,k] to call for each evaluated Chr."]]

ChrSimplify := Module[{},
	tempo = Timing[
		For[ i= 0, i<=d, i++, For[j=0, j<=d, j++, For[k=0, k<=d, k++, ChrE[k,i,j] = Simplify[ChrE[k,i,j]]]]];];
	Print["Christofell symbols simplification time:", tempo[[1]]];];

ChrPrint := Module[{},
	For[ i= 0, i<=d, i++, For[j=0, j<=d, j++, For[k=0, k<=j, k++, 
		If[ ChrE [i,k,j] === 0, Null, Print["ChrE[",i,",",k,",",j,"] = ", ChrE[i,k,j]]]]]];]

ChrESP := Module[{},ChrEvaluate; ChrSimplify; ChrPrint]

ChrESP

Exercício para nota: Em 3 partes (se for feito usando o Mathematica, mas se for feito usando outra linguagem, pular o item i):
i) Reescreva o código acima sem usar For, sugiro usar Do ou Table (bem fácil). 
ii) Acima, foi usada uma função ChrE que serve de memória para Chr. Como visto antes, não é necessário definirmos novo nome de função para fazer uso de memória.
iii) Defina nova função ChrT que tenha como resultado uma tabela com todos os valores de Chr para dada métrica. Tudo de forma completamente em acordo com programação funcional, ou seja, a função em si não deve mudar nada do contexto (valores de variáveis globais), e nem deve estar sujeita a mudanças do contexto. Por exemplo Sin[20], Plot[x,{x,0,10}], Append[...,...] são todos exemplos de funções em completo acordo com programação funcional. A função AppendTo, por exemplo, é uma das excessões do Mathematica.