Skip to main content

list manipulation - Automate table to display figures


With reference to the post Automate Poisson Football Scores Prediction, I succeded in defining the Poisson probability density function for home (μh=A) and away (μa=B) teams, but cannot create a table/matrix taking into account the next matches round thanks to the vector matchesENG and the product between p[A, x]*p[B, x] because I am not able to recognize the actual home team and away team for each match and displaying the scores. Here the complete nb.


ClearAll;
Cl = Import["https://www.soccerstats.com/homeaway.asp?league=england",
    "Data"];
Chome = Drop[Drop[Cl[[2, 4, 1]]], 1];
Caway = Drop[Drop[Cl[[2, 4, 2]]], 1];
teamsENG = Chome[[All, 2]];
dataENG = 

  Import["https://www.soccerstats.com/results.asp?league=england&\
pmtype=bydate", "Data"];
Drop[Drop[Drop[Cases[dataENG, {_, _, _, _}, Infinity], -4], -1, None],
   None, -1];
Take[Table[
   If[StringContainsQ[%[[i, 2]], ":"] == True, %[[i]], ## &[]], {i, 1,
     Length[%]}], Length[teamsENG]/2];
Table[StringSplit[%[[i]], "-"], {i, 1, Length[%]}];
matchesENG = 
  Transpose[{StringTrim[%[[All, 3, 1]]], StringTrim[%[[All, 3, 2]]]}];

A = ConstantArray[0, Length[teamsENG]];
B = ConstantArray[0, Length[teamsENG]];
Do[Do[Table[
    If[matchesENG[[i, 1]] == Chome[[j, 2]] && 
      matchesENG[[i, 2]] == Caway[[k, 2]], 
     A[[j]] = 
      A[[j]] + 
       N[((ToExpression[Chome[[j, 7]]]/
             ToExpression[Chome[[j, 3]]]) + (ToExpression[
              Caway[[k, 8]]]/ToExpression[Caway[[k, 3]]]))/

         2], ## &[]], {k, 1, Length[teamsENG]}], {j, 1, 
    Length[teamsENG]}], {i, 1, Length[matchesENG]}];
Do[Do[Table[
    If[matchesENG[[i, 1]] == Chome[[j, 2]] && 
      matchesENG[[i, 2]] == Caway[[k, 2]], 
     B[[k]] = 
      B[[k]] + 
       N[((ToExpression[Chome[[j, 8]]]/
             ToExpression[Chome[[j, 3]]]) + (ToExpression[
              Caway[[k, 7]]]/ToExpression[Caway[[k, 3]]]))/

         2], ## &[]], {k, 1, Length[teamsENG]}], {j, 1, 
    Length[teamsENG]}], {i, 1, Length[matchesENG]}];
μhome = Transpose[{teamsENG, A}];
μaway = Transpose[{teamsENG, B}];
ph[μh_, xh_] := PDF[PoissonDistribution[μh], xh];
Gh = Table[
   If[μhome[[i, 2]] > 0, {μhome[[i, 1]], 
     Table[ph[μhome[[i, 2]], x], {x, 0, 10}]}, ## &[]], {i, 1, 
    Length[μhome]}];
pa[μa_, xa_] := PDF[PoissonDistribution[μa], xa];

Ga = Table[
   If[μaway[[i, 2]] > 0, {μaway[[i, 1]], 
     Table[ph[μaway[[i, 2]], x], {x, 0, 10}]}, ## &[]], {i, 1, 
    Length[μaway]}];

I tried something like that to take next match home/away teams, but I cannot organize/display the result in a very clear and understandable manner.


X = Table[
   Table[If[
     matchesENG[[i, 1]] == Gh[[j, 1]] && 
      matchesENG[[i, 2]] == Ga[[k, 1]], 

     Table[Gh[[j, 2, l]]*Ga[[k, 2, m]], {l, 1, 10}, {m, 1, 
       10}], ## &[]], {j, 1, Length[Gh]}, {k, 1, Length[Ga]}], {i, 1, 
    Length[matchesENG]}];

Please, any help?



Answer



We can use matches, goalshome and goalsaway from user12590788's self-answer to define three associations:


{asmatches, ashome, asaway} = Association[Rule@@@#] & /@ {matches, goalshome, goalsaway};

Use Outer to get a table of products of associated entries:



outer = Outer[Times, ashome @ #, asaway @ #2] &;

Prepend the table with a column containing home team:


addfirstColumn = Join[List /@ {#, SpanFromAbove, SpanFromAbove}, outer@##, 2] &;

Add a row containing the visitor team name before and a blank row after each block:


kvm = Join[{{#2, SpanFromLeft, SpanFromLeft, SpanFromLeft}}, 
    addfirstColumn @ ##, 
   {{"", SpanFromLeft, SpanFromLeft, SpanFromLeft}}] &;


Use KeyValueMap to map kvm to asmatches:


grid = Join @@ KeyValueMap[kvm, asmatches];

Grid[grid, Alignment -> {Center, Center}, Dividers -> All, BaseStyle -> 16]

enter image description here


To combine all steps into a function that creates the desired grid given three lists as input:


ClearAll[makeGrid]
makeGrid[ml_, ghl_, gal_] :=  Module[{asm, ash, asa, outer, 
    headerC, headerR, blankR, kvM,

    assocs = Map[Apply[AssociationThread]@*Transpose] @ {ml, ghl, gal}},
  {asm, ash, asa} = assocs;
  outer = Outer[Times, ash@#, asa @#2] &;
  headerC = List /@ Join[{#}, ConstantArray[SpanFromAbove, Length[ash@#] - 1]] &;
  headerR = {Join[{#}, ConstantArray[SpanFromLeft, Length@asa@#]]} &;
  blankR = {Join[{""}, ConstantArray[SpanFromLeft, Length@asa@#]]} &;
  kvM = Join[headerR@#2, Join[headerC @#, outer@##, 2], blankR@#2] &;
  Join @@ KeyValueMap[kvM, asm]]

Use makeGrid[matches, goalshome, goalsaway] as first argument in Grid and add the desired grid options:



Grid[makeGrid[matches, goalshome, goalsaway], 
 Alignment -> {Center, Center}, BaseStyle -> 16]


same picture as above



An alternative, and simpler, approach is to create a separate grid for each pair in matches and use Labeled to label each grid:


{ashome, asaway} = Association[Rule @@@ #] & /@ {goalshome, goalsaway};

Column[matches /. {a_, b_} :> Labeled[

   Grid[Outer[Times, ashome @ a, asaway @ b], Dividers -> All], 
   {a, b},
   {Left, Top}]]

enter image description here


Note: Both methods work if the lengths of the goals lists are not the same for all teams:


SeedRandom[1]
matches2 = Partition[RandomSample[Array[Symbol["team" <> ToString@#] &, 10]],  2];

goalshome2 = Thread[matches2[[All, 1]] -> Table[RandomReal[1, RandomInteger[{2, 5}]], 5]];


goalsaway2 = Thread[matches2[[All, -1]] -> Table[RandomReal[1, RandomInteger[{2, 5}]], 5]];

{ashome2, asaway2} = Association[Rule @@@ #] & /@ {goalshome2, goalsaway2};

Column[matches2 /. {a_, b_} :> 
   Labeled[Grid[Outer[Times, ashome2@a, asaway2@b], 
     Dividers -> All], {a, b}, {Left, Top}], Dividers -> All]

enter image description here



Comments

Post a Comment

Popular posts from this blog

functions - Get leading series expansion term?

Given a function f[x] , I would like to have a function leadingSeries that returns just the leading term in the series around x=0 . For example: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x)] x and leadingSeries[(1/x + 2 + (1 - 1/x^3)/4)/(4 + x)] -(1/(16 x^3)) Is there such a function in Mathematica? Or maybe one can implement it efficiently? EDIT I finally went with the following implementation, based on Carl Woll 's answer: lds[ex_,x_]:=( (ex/.x->(x+O[x]^2))/.SeriesData[U_,Z_,L_List,Mi_,Ma_,De_]:>SeriesData[U,Z,{L[[1]]},Mi,Mi+1,De]//Quiet//Normal) The advantage is, that this one also properly works with functions whose leading term is a constant: lds[Exp[x],x] 1 Answer Update 1 Updated to eliminate SeriesData and to not return additional terms Perhaps you could use: leadingSeries[expr_, x_] := Normal[expr /. x->(x+O[x]^2) /. a_List :> Take[a, 1]] Then for your examples: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x), x] leadingSeries[Exp[x], x] leadingSeries[(1/x + 2 + (1 - 1/x...
Post a Comment
Read more

mathematical optimization - Minimizing using indices, error: Part::pkspec1: The expression cannot be used as a part specification

I want to use Minimize where the variables to minimize are indices pointing into an array. Here a MWE that hopefully shows what my problem is. vars = u@# & /@ Range[3]; cons = Flatten@ { Table[(u[j] != #) & /@ vars[[j + 1 ;; -1]], {j, 1, 3 - 1}], 1 vec1 = {1, 2, 3}; vec2 = {1, 2, 3}; Minimize[{Total@((vec1[[#]] - vec2[[u[#]]])^2 & /@ Range[1, 3]), cons}, vars, Integers] The error I get: Part::pkspec1: The expression u[1] cannot be used as a part specification. >> Answer Ok, it seems that one can get around Mathematica trying to evaluate vec2[[u[1]]] too early by using the function Indexed[vec2,u[1]] . The working MWE would then look like the following: vars = u@# & /@ Range[3]; cons = Flatten@{ Table[(u[j] != #) & /@ vars[[j + 1 ;; -1]], {j, 1, 3 - 1}], 1 vec1 = {1, 2, 3}; vec2 = {1, 2, 3}; NMinimize[ {Total@((vec1[[#]] - Indexed[vec2, u[#]])^2 & /@ R...
Post a Comment
Read more

What is and isn't a valid variable specification for Manipulate?

I have an expression whose terms have arguments (representing subscripts), like this: myExpr = A[0] + V[1,T] I would like to put it inside a Manipulate to see its value as I move around the parameters. (The goal is eventually to plot it wrt one of the variables inside.) However, Mathematica complains when I set V[1,T] as a manipulated variable: Manipulate[Evaluate[myExpr], {A[0], 0, 1}, {V[1, T], 0, 1}] (*Manipulate::vsform: Manipulate argument {V[1,T],0,1} does not have the correct form for a variable specification. >> *) As a workaround, if I get rid of the symbol T inside the argument, it works fine: Manipulate[ Evaluate[myExpr /. T -> 15], {A[0], 0, 1}, {V[1, 15], 0, 1}] Why this behavior? Can anyone point me to the documentation that says what counts as a valid variable? And is there a way to get Manpiulate to accept an expression with a symbolic argument as a variable? Investigations I've done so far: I tried using variableQ from this answer , but it says V[1...
Post a Comment
Read more