Neural nets for Natural Language Processing

Featuring various neural nets for sequence based applications

Different task families involving sequences:

Classification of sequences

“Sequence-to-Sequence”

Playing around with a few simple “pretext” examples: a particularly bad example for machine learning (within the reach of a few lines of classic code),  however very handy for teaching purpose...

1. Foundations

net = NetModel["Wolfram English Character-Level Language Model V1" ]

Evaluate the net on inputs

net[HoldComplete[Integrate[x,{x,0,1}]]]

This network was trained to predict the next character given a left hand side context.

net["wha"]

Try batch evaluation:

net[{"wha","whe", "whi"}]

Timing test:

text = ExampleData[{"Text","AliceInWonderland"}];

ClearAll[RandomSnippetExtract]

RandomSnippetExtract[atext_String, numberOfSnippets_:1] := Block[
	{
	textLength = StringLength@atext,
	snippetLength = 10,
	startPositions,
	positions
	},
startPositions = RandomInteger[textLength - snippetLength, numberOfSnippets];
positions = Transpose[{startPositions, startPositions + 10}];
StringTake[atext, positions]
];

testData = RandomSnippetExtract[text,500];

RandomChoice[testData,3]

AbsoluteTiming[map =Map[ net,testData];]
AbsoluteTiming[batch = net[testData];]
map === batch

2. What is the net made of: net surgery

2.a. input pre-processing

Networks process numerical data -- translation operated by NetDecoder

preProcessing = net[["Input"]]

preProcessing["wha"]

A NetEncoder is attached to the input port of the actual network: “fire” the interpreter to get the latter:

rawNet = NetReplacePart[net,"Input"->Automatic ]

2.b. A richer encoding: embeddings

Take the chain first stage (first layer, i.e. encoding stage)

firstStepNet =Take[net,1]

firstStepNet["w"]//MatrixForm
firstStepNet["wh"]//MatrixForm
firstStepNet["wha"]//MatrixForm

Extracting the first layer alone is simple:

firstLayer=net[[1]]

EmbeddingLayer maps the collection of input integers to a collection of fixed-size vectors

The sequence of integer becomes a sequence of vectors:

firstLayer[{90}]//MatrixForm
firstLayer[{90,75}]//MatrixForm
firstLayer[{90,75,68}]//MatrixForm

Vectors value can be learned at training time and to encode the semantic of the input world.

trained embedding can be reused on various application

wordEmbedding = NetModel["GloVe 50-Dimensional Word Vectors Trained on Wikipedia and Gigaword-5 Data"]

wordEmbedding["money for nothing"]//MatrixForm

WordDistance[word1_, word2_]:=CosineDistance[First@wordEmbedding[word1],First@wordEmbedding[word2]]

WordDistance["ship","boat"]
WordDistance["boat","carrot"]
WordDistance["carrot","zucchini"]

2.c. Deeper in the net, processing

Processing in a network: staking layers to obtain rich transformations

Second layer seems idle at the moment...

upToSecondLayer=Take[net,{1,2}]

firstStepNet["wha"]===upToSecondLayer["wha"]

secondStepNet=Take[net,{1,3}]

Each vector is processed according to its past context.

secondStepNet["wha"]//MatrixForm

net[[3]]

How recurrent layers work using a single layer graph:

gru = NetGraph[
	(* here we define and name the graph nodes i.e. Layers or NetChains or NetGraphs *)
	<|"reccurentLayer" -> net[[3]]|>,
	(* here we list the graph edges connecting the nodes'ports *)
	{
	NetPort["Input"] -> "reccurentLayer",
	NetPort["InitialState"] -> NetPort["reccurentLayer","State"]
	}
	]

gru[<|"Input"-> firstStepNet["w"],"InitialState"-> ConstantArray[0,512]|>]//MatrixForm

?FoldList

FoldList[
Last@gru[<|"Input"-> {#2},"InitialState"-> #1|>]&,
ConstantArray[0,512],
firstStepNet["wha"]
]//MatrixForm

secondStepNet["wha"]//MatrixForm

2.d. Into the Depth: stacking layers

Stacking layer is a way to create a richer transformation in neural net world.

furtherStepNet=Take[net,{1,5}]

furtherStepNet["wha"]//MatrixForm

2.e. Selecting a vector as representing the input sequence: refereed to as the encoding

EncoderNet=Take[net,{1,6}]

{EncoderNet["wha"]}//MatrixForm

2.g. Decoding: combining the information and generate the answer

NetTake[net,7]

Normalize the output as a distribution over the possible outcomes (probability of next character)

fullNet=NetReplacePart[NetTake[net,8],"Output"-> Automatic]

BarChart[fullNet["wh"],ChartLabels->NetExtract[net,{"Output","Labels"}]]

\[Implies]((())^3)\[Implies]\[Implies]\[Implies]

2.h. output can be post-processed

Transform the result to suit your needs...

net["wha",{"TopProbabilities",3}]

Table[net["wha",{"RandomSample","Temperature"->1}],10]

2. exercise A: Generate a sentence using the language model

Solution:

NetAppendCharacter[text_, temperature_] := text<>net[text, {"RandomSample", "Temperature"->temperature}];
FinishSentence[text_, temperature_, maxLength_] := NestWhile[NetAppendCharacter[#, temperature]&, text, MemberQ[Join[{" ", "'", ",", "-", "(", ")"}, Alphabet[]] , StringTake[#, -1]]& , 1, maxLength];

Test 1:

FinishSentence["wh",1., 100]

Better Solution:

Much more efficient : maintain the states of the network during generation

FinishSentence2[text_, temperature_, maxLength_] := Block[
	{
	sobj = NetStateObject[net],
	sampledchars
	},
sampledchars = NestWhileList[sobj[#, {"RandomSample", "Temperature" -> temperature}]&, text, MemberQ[Join[{" ", "'", ",", "-", "(", ")", "\"", ":", ";"}, Alphabet[]] , StringTake[#, -1]]&, 1, maxLength];
StringJoin[sampledchars]
];

Test 2:

FinishSentence2["wh", 1., 100]

2. exercise B: Use the net to score word probability inside a text

NetInformation[net,"SummaryGraphic"]

Solution

(*a. Surgery: from next character to whole sequence *)
seqnet = NetChain[
	{
	furtherStepNet,
	NetMapOperator[net[[7]]],
	SoftmaxLayer[]
	}
];

(* this generate P[newChar | Past] at all position in inputs *)
WordProbability[lhsText_, word_, rhsText_] := Block[
	{sequence, sequenceProba},
	sequence = NetEncoder[{"Characters",net[["Output","Labels"]]}][lhsText<>word<>rhsText];
	sequenceProba = Most@seqnet[lhsText<>word<>rhsText];
	sequenceProba = Extract[sequenceProba, Transpose[{Range[Length@sequence-1], Rest@sequence}]];
	sequenceProba = Apply[Times, sequenceProba]/Apply[Times, sequenceProba[[;;StringLength[lhsText]-1]]]
]

Test

WordProbability["I am very ", "tired", " of walking"]
WordProbability["I am very ", "happy", " of walking"]
WordProbability["I am very ", "banana", " of walking"]
WordProbability["I am very ", "veyutr", " of walking"]

3. Training similar network on a different classification task

3.1. Hints about data and training

Getting a (very small) toy dataset

dataSet=ExampleData[{"MachineLearning","MovieReview"},"Data"];
{trainingData,validationData}=TakeDrop[dataSet,Floor[0.9* Length@dataSet]];

MapAt[Short,RandomChoice[trainingData,3],{All, 1}]

Generating a network to train:

\[Implies]\[Implies]\[Implies]\[Implies]

encoder= NetChain[
{
EmbeddingLayer[40],
GatedRecurrentLayer[32],
SequenceLastLayer[]
},
"Input"->NetEncoder[{"Tokens"}]
];
decoder = NetChain[
{
LinearLayer[],
SoftmaxLayer[]
},
"Output"-> NetDecoder[{"Class",{"positive","negative"}}]
];
sentimentNet=NetChain[{encoder, decoder}]

Train!

trainingResult=NetTrain[sentimentNet,trainingData, All, ValidationSet-> validationData ]

ClassifierMeasurements[trainingResult["TrainedNet"], trainingData,"Accuracy"]
ClassifierMeasurements[trainingResult["TrainedNet"], validationData,"Accuracy"]

3.2. Regularization: EarlyStopping and DropoutLayer

encoder= NetChain[
{
EmbeddingLayer[40],
DropoutLayer[.3],
GatedRecurrentLayer[32],
SequenceLastLayer[]
},
"Input"->NetEncoder[{"Tokens"}]
];
decoder = NetChain[
{
LinearLayer[],
SoftmaxLayer[]
},
"Output"-> NetDecoder[{"Class",{"positive","negative"}}]
];
sentimentNet=NetChain[{encoder, decoder}]

trainingResult=NetTrain[sentimentNet,trainingData, All, ValidationSet-> validationData,TimeGoal-> Quantity[1, "Minutes"] ]

Check accuracy:

ClassifierMeasurements[trainingResult["TrainedNet"], trainingData,"Accuracy"]
ClassifierMeasurements[trainingResult["TrainedNet"], validationData,"Accuracy"]

3.2. Transferring knowledge (and regularization by freezing weights)

encoder= NetChain[
{
NetModel["GloVe 25-Dimensional Word Vectors Trained on Tweets"],
DropoutLayer[.3],
NetBidirectionalOperator[GatedRecurrentLayer[32],Total],
SequenceLastLayer[]
}
];
decoder = NetChain[
{
LinearLayer[],
SoftmaxLayer[]
},
"Output"-> NetDecoder[{"Class",{"positive","negative"}}]
];
sentimentNet=NetChain[{encoder, decoder}]

trainingResult=NetTrain[sentimentNet,trainingData, All, ValidationSet-> validationData,LearningRateMultipliers-> {{1,1}-> None},TimeGoal-> Quantity[3, "Minutes"] ]

ClassifierMeasurements[trainingResult["TrainedNet"], trainingData,"Accuracy"]
ClassifierMeasurements[trainingResult["TrainedNet"], validationData,"Accuracy"]

4. Encoding, Recurrence and Attention in complex classification task

4.1. Recurrence:

ro=ResourceObject["The 20-Task bAbI Question-Answering Dataset v1.2"]
traindata=ResourceData[ro,"TrainingData"]["Task1"];
testdata=ResourceData[ro,"TestData"]["Task1"];

Dataset@traindata[[All,100]]

Gather a list of all vocabulary context and another of possible answers:

dict=Union@@TextWords[Join[traindata["Context"],traindata["Question"]]]
classes=Union[traindata["Answer"]]

Encode Context and Question in a single vector to classify:

encoderContext= NetChain[
{
EmbeddingLayer[40],
GatedRecurrentLayer[32],
SequenceLastLayer[]
},
"Input"->NetEncoder[{"Tokens", Append[dict,"." ]}]
];
encoderQuestion= NetChain[
{
EmbeddingLayer[40],
GatedRecurrentLayer[32],
SequenceLastLayer[]
},
"Input"->NetEncoder[{"Tokens", Append[dict,"." ]}]
];
decoder = NetGraph[
{
LinearLayer[],
SoftmaxLayer[]
},
{1-> 2->  NetPort["Answer"]},
"Answer"-> NetDecoder[{"Class",classes}]
];
QuestionAnsweringNet=NetGraph[{encoderContext, encoderQuestion,CatenateLayer[], decoder},{NetPort["Context"]->1 ,NetPort["Question"]-> 2,{1,2}->3->4}]

Training

TrainedQA=NetTrain[QuestionAnsweringNet,traindata, ValidationSet->testdata ]

Accuracy ?

N@Count[MapThread[SameQ,{TrainedQA[KeyDrop[testdata,"Answer"]],testdata["Answer"]}],True]/Length[testdata["Answer"]]

4.2. Recurrence with a sequence as encoding:

QuestionAnsweringNet=NetGraph[
<|
"contextEncoding"->{EmbeddingLayer[40],DropoutLayer[0.3]},
"questionEncoding"->{EmbeddingLayer[40],DropoutLayer[0.3],GatedRecurrentLayer[32],SequenceLastLayer[]},
"cat"->CatenateLayer[],
"classifier"->{GatedRecurrentLayer[50],SequenceLastLayer[],DropoutLayer[0.3],LinearLayer[],SoftmaxLayer[]}|>,
{
NetPort["Context"]->"contextEncoding",
NetPort["Question"]->"questionEncoding",
{"questionEncoding","contextEncoding"}->"cat",
"cat"->"classifier"->NetPort["Answer"]
},
"Context"->NetEncoder[{"Tokens", Append[dict,"." ]}],
"Question"->NetEncoder[{"Tokens", Append[dict,"." ]}],
"Answer"->NetDecoder[{"Class",classes}]]

TrainedQA=NetTrain[QuestionAnsweringNet,traindata, ValidationSet->testdata ]

N@Count[MapThread[SameQ,{TrainedQA[KeyDrop[testdata,"Answer"]],testdata["Answer"]}],True]/Length[testdata["Answer"]]

4.3. Attention:

scan question over context to attend at the currently most interesting part:

QuestionAnsweringNet=NetGraph[
<|
"contextEncodingKey"->{EmbeddingLayer[40],DropoutLayer[0.3],GatedRecurrentLayer[32]},
"contextEncodingValue"->{EmbeddingLayer[40],DropoutLayer[0.3],GatedRecurrentLayer[32]},
"questionEncoding"->{EmbeddingLayer[40],DropoutLayer[0.3],GatedRecurrentLayer[32]},
"attention"-> AttentionLayer[],
"cat"->CatenateLayer[2],
"classifier"->{GatedRecurrentLayer[50],SequenceLastLayer[],LinearLayer[],SoftmaxLayer[]}
|>,
{
NetPort["Context"]->"contextEncodingKey",
NetPort["Context"]->"contextEncodingValue",
NetPort["Question"]->"questionEncoding",
{"contextEncodingKey","contextEncodingValue", "questionEncoding"}->"attention",
{"attention", "questionEncoding"}-> "cat",
"cat"->"classifier"->NetPort["Answer"]
},
"Context"->NetEncoder[{"Tokens", Append[dict,"." ]}],
"Question"->NetEncoder[{"Tokens", Append[dict,"." ]}],
"Answer"->NetDecoder[{"Class",classes}]
]

TrainedQA=NetTrain[QuestionAnsweringNet,traindata, ValidationSet->testdata ]

N@Count[MapThread[SameQ,{TrainedQA[KeyDrop[testdata,"Answer"]],testdata["Answer"]}],True]/Length[testdata["Answer"]]

5. Encoding, Recurrence and Attention in Sequence Generation tasks

5.1 Translation: encoder-decoder with sequence embedding

Generate a dataset of translation:

integerNameTable = AssociationMap[IntegerName, Range[0, 9]];
DummyIntegerName = Lookup[integerNameTable, #]&;
CreateExample[sequence_] := Map[ToString]@sequence -> StringRiffle[KeyValueMap[StringRiffle[DummyIntegerName[{#2, #1}], " "]&, Counts[Sort[sequence]]], " and "];

10^5

Data=RandomSample[Map[CreateExample]@Flatten[Table[{i, j, k, l, m}, {i, 0, 9},{j, 0, 9},{k, 0,9},{l, 0, 9},{m, 0, 9}],4]];
{trainingData, keptData}= TakeDrop[Data, Floor[Length@Data*0.8]];
{ validationData, testData}=TakeDrop[keptData, Floor[Length@keptData*0.5]];
example=RandomChoice[trainingData]

Encoder-Decoder architecture

encoderNet = NetChain[
{
EmbeddingLayer[40],
 GatedRecurrentLayer[32],
 SequenceLastLayer[]
}
];
decoderNet = NetGraph[
{
	EmbeddingLayer[40],
	GatedRecurrentLayer[32],
	NetMapOperator[LinearLayer[]],
	SoftmaxLayer[]
	},
{ 
NetPort["PreviousOutput"] -> 1 -> 2 -> 3 -> 4,
NetPort["Input"] -> NetPort[2, "State"]
}
];

TeacherForcing Training: feeding back expected answer to the decoder to generate the next element

With “Teacher Forcing”, we use the target symbols instead of the network output predictions

example=RandomChoice[trainingData]

input=example[[1]]
target=Append[#,"eos" ]&@Prepend[#,"sos" ]&@StringSplit[example[[2]]]
teacher=Most@target
exampleOut={"two","and","and","one","three","and","one","eos","six","and","one","seven"}
lossReference=Rest@target

teacherForcingNet[encoderNet_, decoderNet_] := NetGraph[
	<| 
		"encoder" -> encoderNet, 
		"decoder" -> decoderNet,
		"most" -> SequenceMostLayer[], 
		"rest" -> SequenceRestLayer[],
		"loss" -> CrossEntropyLossLayer["Index"]
	|>,
	{
		NetPort["Input"] -> "encoder" -> NetPort["decoder", "Input"],
		NetPort["Target"] ->  "most" -> NetPort["decoder", "PreviousOutput"],
		"decoder" -> NetPort["loss", "Input"],
		NetPort["Target"] -> "rest" -> NetPort["loss", "Target"]
	},
	"Input" -> NetEncoder[{"Class", Map[ToString]@Range[0, 9]}],
	"Target" -> NetEncoder[{"Tokens", Join[IntegerName@Range[0,9], {"and", "sos", "eos"}]}]
]

netToTrain = teacherForcingNet[encoderNet, decoderNet]

makeTeacherForcingTarget =Function[dataset, MapAt["sos "<>#<>" eos"&, dataset, {All, 2}]];

{trainingDataTF, validationDataTF, testDataTF}=makeTeacherForcingTarget/@{trainingData, validationData, testData};

trainingResults= NetTrain[ netToTrain, trainingDataTF, All,ValidationSet -> validationDataTF]

TeacherForcing Generation: which answer to feed back to the decoder?

trainingResults["TrainedNet"]

trainedEncoderNet =NetReplacePart[ NetExtract[trainingResults["TrainedNet"], "encoder"],"Input"->NetEncoder[{"Class", Map[ToString]@Range[0, 9]}]]
trainedDecoderNet = NetExtract[trainingResults["TrainedNet"], "decoder"]

Several options to make prediction out of that:

Test all possibilities : NP-hard!

Beam-search : Iteratively prune alternatives.

Greedy : Fastest.

enc=trainedEncoderNet[ToString/@{1,3,2,2,4}]

trainedDecoderNet
decodersLayers=NetExtract[trainedDecoderNet,All]

trainedDecoderNet1 = NetChain[Join[decodersLayers[[;;2]], { SequenceLastLayer[], NetExtract[decodersLayers[[3]], "Net"], SoftmaxLayer[]}],"Input"-> NetExtract[trainingResults["TrainedNet"],"Target"],"Output"-> NetDecoder[NetExtract[trainingResults["TrainedNet"],"Target"]]]

greedyDecoding[input_, max_]:=With[
{initstate = trainedEncoderNet[input]},
decoder=NetStateObject[trainedDecoderNet1,<|{2,"State"}:>initstate|>]; 
StringRiffle@Most@Rest@NestWhileList[decoder,"sos",Not@MatchQ[#, "eos"]&,1, max]
]

greedyDecoding[ToString/@{1,3,3,4,2}, 100]

greedy Accuracy (long to run):

RandomChoice@testData

N@Count[MapThread[SameQ,{Map[greedyDecoding[#,100]&, testData[[All,1]]],testData[[All,2]]}],True]/Length@testData

5.2 Translation: encoder-decoder with sequence embedding

Network architecture

encoderNet = NetGraph[
{EmbeddingLayer[40],DropoutLayer[0.3],GatedRecurrentLayer[32],GatedRecurrentLayer[32]},
{1-> 2-> 3-> NetPort["Keys"], 2-> 4-> NetPort["Values"]}
]
decoderNet = NetGraph[
{EmbeddingLayer[40],DropoutLayer[0.3],GatedRecurrentLayer[32],AttentionLayer[],CatenateLayer[2],GatedRecurrentLayer[32], NetMapOperator[LinearLayer[]], SoftmaxLayer[]},
{NetPort["PreviousOutput"]->1-> 2->3,{NetPort["Keys"],NetPort["Values"],3}-> 4, {4, 3}-> 5->6->7->8}
]

teacherForcingNet[encoderNet_, decoderNet_] := NetGraph[
	<| 
		"encoder" -> encoderNet, 
		"decoder" -> decoderNet,
		"most" -> SequenceMostLayer[], 
		"rest" -> SequenceRestLayer[],
		"loss" -> CrossEntropyLossLayer["Index"]
	|>,
	{
		NetPort["Input"] -> "encoder" ,
	NetPort["encoder", "Keys"]-> NetPort["decoder", "Keys"],
	NetPort["encoder", "Values"]-> NetPort["decoder", "Values"],
		NetPort["Target"] ->  "most" -> NetPort["decoder", "PreviousOutput"],
	NetPort["Target"] -> "rest" -> NetPort["loss", "Target"],
		"decoder" -> NetPort["loss", "Input"]
	},
	"Input" -> NetEncoder[{"Class", Map[ToString]@Range[0, 9]}],
	"Target" -> NetEncoder[{"Tokens", Join[IntegerName@Range[0,9], {"and", "sos", "eos"}]}]
]

netToTrain=teacherForcingNet[encoderNet, decoderNet]

Training by teacher forcing:

trainingResults= NetTrain[ netToTrain, trainingDataTF, All,ValidationSet -> validationDataTF]

Exercise: Generation...

Exercise: Inspect Attention weighs during generation...

6. Beyond “Lookup” embeddings - convolution very useful in NLP too:

NetModel["Wolfram Entity Recognition Net for TextCases WL 12.0 V1"]

7. Openings...

More things to look at

Pointer networks (i.e. Softmax over sequence length to identify positions of interests)

CTCLossLayer (i.e. Compute every possible sequence alinement with blanks)

Check out NetTrain “Applications” documentation section for more tutorials

Check out Neural Network documentation page to see layers in the system

Check out the excellent talks on neural networks in the coming days