2
$\begingroup$

I have the following code:

ClearAll[regions, country, plf, PoU];

regions = {"Africa", "Africa", "Africa", "Africa", "Africa", "Africa",
"Africa", "Africa", "Africa", "Africa", "Africa", "Africa", 
"Africa", "Africa", "Africa", "Africa", "Africa", "Arab", "Arab", 
"Arab", "Arab", "Arab", "Arab", "Arab", "Arab", "Arab", "Arab", 
"Arab", "Arab", "Arab", "Arab", "Arab", "Asia", "Asia", "Asia", 
"Asia", "Asia", "Asia", "Asia", "Asia", "Asia", "Asia", "Asia", 
"Asia", "Asia", "Asia", "Asia", "Asia", "Asia"};

country = {"Mali", "Cameroon", "Benin", "Gambia", "Gabon", "Senegal", 
"Nigeria", "Togo", "Guinea", "Niger", "CôtedIvoire", 
"Burkina Faso", "Sierra Leone", "Mozambique", "Guinea Bissau", 
"Chad", "Uganda", "UAE", "Kuwait", "Morocco", "Algeria", "Tunisia",
"Egypt", "Oman", "Saudi Arabia", "Mauritania", "Lebanon", 
"Jordan", "Djibouti", "Sudan", "Iraq", "Yemen", "Azerbaijan", 
"Kazakhstan", "Turkey", "Malaysia", "Brunei Darus", "Iran", 
"Turkmenistan", "Albania", "Uzbekistan", "Kyrgyzstan", "Guyana", 
"Indonesia", "Suriname", "Maldives", "Bangladesh", "Pakistan", 
"Afghanistan"};

plf = {30, 26, 35, 30, 4, 48, 35, 52, 35, 13, 26, 74, 100, 43, 17, 26,
74, 9, 26, 26, 22, 13, 9, 9, 9, 26, 17, 22, 13, 13, 9, 13, 26, 52,
30, 13, 17, 26, 9, 26, 52, 52, 4, 30, 30, 48, 74, 13, 52};

PoU = {6, 10, 10, 10, 11, 11, 13, 16, 17, 17, 19, 20, 26, 28, 28, 38, 
41, 3, 3, 3, 4, 4, 5, 7, 7, 10, 11, 12, 19, 20, 29, 39, 1, 1, 1, 3,
3, 5, 5, 6, 6, 7, 8, 8, 9, 10, 15, 20, 30};

ListPlot[Transpose@{plf, PoU} -> regions, 
AxesLabel -> {"Policy and Legal\nFramework", "PoU"}, 
PlotStyle -> {Thick, PointSize[Large]}, GridLines -> Automatic]

which produces a scatter plot of countries across 3 regions. Each data point is labeled with the region name. Here are 3 tasks that I like to do using Manipulate[...].

  1. Produce a single scatter plot of all the data points in which individual data points within a region will be of the same color (with a region color label on the right of the plot).
  2. Draw a regression line on top of the scatter plot using all the data points and show the regression line with a "black dashed line".
  3. Draw a regression line for region A, for example, on top of the scatter plot using the data points of that region only, while keeping all of the data points in the data set on the plot. Assign the region A regression line the same color as region A so that one can see that the regression line is linked to the specific observations. The same operations should be repeated for other regions also. Eventually, I should be able to see all the 3 regional regression lines and the global regression line (black dashed line) on a single plot for regional comparison purposes.

Thank you for your help.

$\endgroup$
4
  • 1
    $\begingroup$ You can use something like the following to get to point 1 above: ListPlot[Evaluate@ GroupBy[Last -> First]@Thread[Transpose@{plf, PoU} -> regions]]. I hope you won't mind me saying that, as asked, this question feels a bit like "work for hire": those are tedious but relatively simple tasks that could be accomplished using combinations of LinearModelFit and Plot, PlotLegends, Directive etc. Perhaps you could show us what you have tried so far, and where you got stuck. $\endgroup$
    – MarcoB
    Jan 15, 2020 at 15:25
  • $\begingroup$ @MarcoB: Thank you for the suggestion. I am not a programmer, but use MMA to help my research. Pieces of my question, as you said, are easy, but for me, it is not easy to link two separate results in Manipulate, which is the main issue in my question. I will remove the real content from the question and present it as a generic question to combine ListPlot and LinearModelFit. Will this type of question be proper in this forum? Thanks. $\endgroup$ Jan 15, 2020 at 16:13
  • $\begingroup$ I'd rather you did NOT remove the real content. It makes it much easier to work when a example with data is presented! However, it is unclear to me what you would like the Manipulate to accomplish. Do you want to be able to select one subgroup at a time for the regression (e.g. Africa, etc)? $\endgroup$
    – MarcoB
    Jan 15, 2020 at 16:16
  • $\begingroup$ @MarcoB: When I was replying to you, I received an answer from @kglr. I think all my questions are addressed in his code. Yes, I was trying to construct a Manipulate to select a subgroup with the plot and the regression line (maybe with a button for each subgroup), while keeping all the observations on the plot. $\endgroup$ Jan 15, 2020 at 16:35

1 Answer 1

4
$\begingroup$
groupeddata = GatherBy[Thread[Transpose@{plf, PoU} -> regions], Last];
fits = Fit[#, {1, x}, x] & /@ Keys[groupeddata];
fitall = Fit[Transpose@{plf, PoU}, {1, x}, x];

Show[ListPlot[groupeddata, 
  AxesLabel -> {"Policy and Legal\nFramework", "PoU"}, 
  PlotStyle -> {Thick, PointSize[Large]}, GridLines -> Automatic, 
  ImageSize -> Large, 
  PlotLegends -> SwatchLegend[Automatic, Union[regions], LegendMarkers -> "Bubble"]], 
 Plot[Evaluate[Append[fits, fitall]], {x, 0, 100}, 
  PlotStyle -> 
   (Directive[#, Thick, Dashed] & /@ Append[ColorData[97] /@ Range[3], Black]),
  PlotLegends -> "Expressions"]]

enter image description here

Update: Adding a TogglerBar to control the list of fit lines to be shown:

colors = Append[ColorData[97, "ColorList"][[;; 3]], Black];
labels = Append[Union[regions], "All"];
fitfuncs = Append[fits, fitall];
plots = Table[Plot[fitfuncs[[i]], {x, 0, 100}, 
    PlotStyle -> Directive[colors[[i]], Thick, Dashed]], {i, 4}];
lp = ListPlot[Keys @ groupeddata, 
   AxesLabel -> {"Policy and Legal\nFramework", "PoU"}, 
   PlotStyle -> PointSize[Large], GridLines -> Automatic];

DynamicModule[{select = {1, 2, 3, 4}}, 
 Dynamic@Show[{lp, plots[[select]]}, Axes -> True, ImageSize -> 800, 
   PlotLabel -> TogglerBar[Dynamic[select], 
     Table[i -> Grid[{{SwatchLegend[{colors[[i]] /. Black -> White}, 
         {labels[[i]]}, LegendMarkers -> "Bubble"]},
      {Item[Pane[LineLegend[{Directive[Opacity[1, colors[[i]]], Thick, Dashed]}, 
        {Style[fitfuncs[[i]] /. x_Real :> Round[x, .0001], FontColor -> Black]}], 
        Alignment -> Center], Background -> Opacity[.3, colors[[i]]], 
        FrameStyle -> If[MemberQ[select, i], 
             Directive[Thick, Darker@colors[[i]]], 
             Opacity[0]]]}}], {i, 1, 4}], Appearance -> "Frameless"]]]

enter image description here

$\endgroup$
4
  • $\begingroup$ Since regions have colored labels on the right, I tried to remove region names from the ListPlot, but I could not do it. Do you mind showing me where to revise your code? Thank you very much for your timely answer. $\endgroup$ Jan 15, 2020 at 18:08
  • 1
    $\begingroup$ @TugrulTemel, you can use Keys@groupeddata (instead of groupeddata) in the first argument of ListPlot. $\endgroup$
    – kglr
    Jan 15, 2020 at 18:24
  • $\begingroup$ Thank you very much. $\endgroup$ Jan 15, 2020 at 18:33
  • $\begingroup$ Really, your efforts are of paramount importance. Thank you very much. $\endgroup$ Jan 20, 2020 at 0:47

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.