machine learning framework for Mathematica

Creating understandable computational models from data

Mario Drobics
Software Competence Center Hagenberg
mario.drobics@scch.at
http: // www . unisoftwareplus . com/
                products/mlf

System

?mlf`*

Iris data set

Setup

Load Packages

Needs["mlf`"]
Needs["Graphics`Graphics`"]

Load data set

\(\(dataRaw = 
        Import[$TopDirectory <> "/AddOns/Applications/mlf/data/iris.txt", "Table"];\)\)
headers = First[dataRaw];
irisData = 
        Def["IrisData", 
          DataSet[Rest[dataRaw],  headers]];
Clear[dataRaw];

Visualization

Scatter plots

Show[
        Graphics@
          PlotAttributes[
irisData, 
Dims -> {3, 4}, 
Goal -> 
              5, 
PointSize -> 
              0.02
], 
 
        Axes -> True, 
AxesLabel -> 
          headers[[{3, 4}]], 
PlotLabel -> 
          headers[[5]]];

curSelection = 
        FOr[
FColPredIsAL[3, 
            FuzzySetExp[5.5, 0.3]], 
FColPredIsAL[4, 
            FuzzySetExp[1.75, 0.05]]];

\(\(Show[
        Graphics@
          PlotAttributes[
irisData, 
Dims -> {3, 4}, 
Goal -> 
              curSelection, 
PointSize -> 
              0.02
], 
\ 
        Axes -> True, 
AxesLabel -> 
          headers[\([{3, 
                4}]\)], 
PlotLabel -> "Iris flowers"];\)\)

\(\(Show[
        Graphics@
          PlotAttributeMatrix[
irisData, 
Dims -> Range@4, 
Goal -> 
              curSelection, 
PointSize -> 
              0.02
], 
        PlotLabel -> "Iris Data"];\)\)

Parallel coordinates

PlotParallelCoordinates[irisData, Goal -> 5];

PlotParallelCoordinates[
irisData, 
Goal -> 
          curSelection
];

PlotParallelCoordinates[
irisData, 
Goal -> 
          FAnd[curSelection, 
            FColPredIsEx [5, 1]]
];

Extract[
GetData@
          irisData, 
Position[
EvalDataSet[
            FAnd[curSelection, FColPredIsEx [5, 1]], 
            irisData], 
_?(# > 
                  0.5 &)]
] // TableForm

Analysis

Cluster data

clustering = 
        CreateKMeans[irisData, Size -> 3, 
          Weights -> {1, 1, 1, 1, 0}];

Show@
        Graphics[
          PlotAttributes[irisData, Dims -> {3, 4}, Goal -> clustering, 
            PointSize -> 0.01], Axes -> True];

Compute a self-organizing map

somIris = CreateSOM[irisData, Size -> {10, 10}];

PlotSOMContour[somIris];

Compute a decision tree

testVars = 
        DefPredicateVars[
          Flatten@CreatePredicates[irisData, {1, 2, 3, 4}, 
              3]];
goalVars = 
        DefPredicateVars[CreatePredicatesIs[irisData, 5]];

id3tree = CreateID3[irisData, testVars, goalVars];

Show@
        Graphics[{PlotClassLegend[goalVars], PlotID3[id3tree]}, 
          AspectRatio -> 0.5, PlotRange -> All];

Compute a rule base

testVars = 
        DefPredicateVars[
          Flatten@CreatePredicates[irisData, {1, 2, 3, 4}, 
              3]];
goalVars = 
        DefPredicateVars[CreatePredicatesIs[irisData, 5]];

ruleBase = CreateFOIL[irisData, testVars, goalVars];

PrintFoilRules[ruleBase]

Approximation with fuzzy decision trees

Set up data

range = 100;
f[x_, y_] := 
        N@(Sin[x/range*2*Pi]*y);
Plot3D[f[x, y], {x, 0, range}, {y, 0, range}];

samples = 1000;
trainData = 
        Table[{x = Random[]*range, y = Random[]*range, 
            f[x, y]}, {samples}];

trainDataSet = 
        Def["DataSet", 
          DataSet[trainData, 
            headers = {"x", "y", "z"}]];

Create predicates

\(\(testPartitions = {
CreatePartition[
trainDataSet, 1, 
            5, 
Border -> True, SetType -> "PWL", 
            SeparateSets -> 
              True
], 
CreatePartition[
trainDataSet, 2, 
            2, 
Overlap -> 0.8, Border -> True, 
            SetType -> "PWL", 
            SeparateSets -> True
]};\)\)
\(\(goalPartitions = 
CreatePartition[
trainDataSet, 3, 3, 
Width -> 1.0, 
          Border -> True, PredType -> "ISEX", SetType -> "PWL", 
          SeparateSets -> True
];\)\)
testPreds = Flatten@testPartitions[[All, 2]];
goalPreds = goalPartitions[[2]];
testVars = DefPredicateVars[testPreds];
goalVars = DefPredicateVars[goalPreds];

Table[
        PlotFuzzySetHistogram[
testPartitions[[i]], 
GetData[trainDataSet, All, 
            i], 
PlotLabel -> 
            headers[[i]]
], {i, 
          Length@testPartitions}];

PlotFuzzySetHistogram[
goalPartitions[[1]], 
GetData[trainDataSet, All, 
          3], 
PlotLabel -> 
          headers[[3]]
];

Compute decision tree

id3tree = 
        CreateID3[trainDataSet, testVars, goalVars, MinConf -> 0.9, 
          MinEnt -> 0.01, MinIncr -> 0.01, Logic -> LogicL, 
          MaxLevel -> 4];
Show[
        Graphics[{PlotClassLegend[goalVars], PlotID3[id3tree]}, 
          AspectRatio -> 0.7], PlotRange -> All];

Recall results

samplesTest = 20;
testData = 
        Flatten[Table[
            Table[{x*range/samplesTest, 
                y*range/samplesTest}, 
{x, 0, 
                samplesTest}], {y, 0, samplesTest}], 1];

recalledData = 
        MakeSugenoInference[id3tree, goalPreds, testData, Type -> "PROB", 
          Logic -> LogicP];

trainMatrix = 
        Partition[Map[(f @@ # &), testData], 
          samplesTest + 1];
recallMatrix = 
        Partition[recalledData /. Null -> 0, 
          samplesTest + 1];

curTicks = {Table[{i, i*5}, {i, 0, 20, 5}], 
          Table[{i, i*5}, {i, 0, 20, 5}], 
          Automatic};
orgPlot = 
        ListPlot3D[trainMatrix, ColorFunction -> Automatic, 
          ColorFunction -> Automatic, 
          Ticks -> 
            curTicks, 
PlotLabel -> "Original \
function", DisplayFunction -> Identity];
recPlot = 
        ListPlot3D[recallMatrix, ColorFunction -> Automatic, 
          PlotRange -> {Automatic, Automatic, {-100, 100}}, 
          Ticks -> 
            curTicks, 
PlotLabel -> "Decision tree \
rule base - recalled function",  
          DisplayFunction -> Identity];
Show[GraphicsArray[{recPlot, orgPlot}], 
        DisplayFunction -> $DisplayFunction];

sumError = 
        Tr@Map[((f[#[[1]], #[[2]]] - #[[3]])^ 2 &), 
            Transpose@
              Append[Transpose@testData, 
                recalledData /. Null -> 0]];

Print["Average Squared Error: ", sumError/(Length@
                recalledData + 1)/(Max@testData - 
              Min@testData)^2]

\(\(Show@
        Graphics[
          PlotInputRecall[Flatten@trainMatrix, Flatten@recallMatrix, 
            PointSize -> 
              0.01], 
AxesLabel -> {"Original", "Recall"}, 
Axes -> True];\)\)

Tune rule base with OptimizeRENO

id3controller = 
        ExtractRuleBaseID3[id3tree,  goalPreds];

partitionNames  =  
        GetPartitionNames[
ExtractDimensionsID3[id3tree, 
            goalPreds], 
          headers
];
xporig = 
      PlotFuzzySet[GetObject[partitionNames[[1]]],  
        DisplayFunction -> Identity,  
        PlotLabel -> "Initial " <> partitionNames[[1]]]; 
    yporig = PlotFuzzySet[GetObject[partitionNames[[2]]],  
        DisplayFunction -> Identity,  
        PlotLabel -> "Initial " <> partitionNames[[2]]]; 
    Show[GraphicsArray[{xporig, yporig}], 
      DisplayFunction -> $DisplayFunction];

reno = 
        OptimizeRENO[trainDataSet, id3controller,  
          PartitionNames -> partitionNames, Dims -> {1, 2}, 
          Goal -> 3,   Beta1 -> {0.000001, 0.000001},  
          Beta2 -> {0.0001, 0.0001}];

xpot = 
      PlotFuzzySet[GetObject[partitionNames[[1]]],  
        DisplayFunction -> Identity,  
        PlotLabel -> "RENO optimized " <> partitionNames[[1]]]; 
    ypot = PlotFuzzySet[GetObject[partitionNames[[2]]],  
        DisplayFunction -> Identity,  
        PlotLabel -> "RENO optimized " <> partitionNames[[2]]]; 
    Show[GraphicsArray[{{xpot, ypot}}], 
      DisplayFunction -> $DisplayFunction];

PrintRENORules[reno]

Recall results

recalledData = MakeSugenoInference[reno, testData];  
    recallMatrix = 
      Partition[recalledData /. Null -> 0, samplesTest + 1];

recPlot = 
        ListPlot3D[recallMatrix, ColorFunction -> Automatic, 
          PlotRange -> {Automatic, Automatic, {-100, 100}}, 
          Ticks -> 
            curTicks, 
PlotLabel -> "Optimized rule \
base - recalled function",  DisplayFunction -> Identity];
Show[GraphicsArray[{recPlot, orgPlot}], 
        DisplayFunction -> $DisplayFunction];

sumError = 
        Tr@Map[((f[#[[1]], #[[2]]] - #[[3]])^ 2 &), 
            Transpose@
              Append[Transpose@testData, 
                recalledData /. 
                  Null -> 0]];
Print["Average Squared Error: ", sumError/(Length@
                recalledData + 
              1)/(Max@recalledData /. 
                Null -> 0 - Min@recalledData /. 
              Null -> 0)^2]

\(\(Show@
        Graphics[
          PlotInputRecall[Flatten@trainMatrix, Flatten@recallMatrix, 
            PointSize -> 
              0.01], 
AxesLabel -> {"Original", "Recall"}, 
Axes -> True];\)\)