RemoteInterface package

A subpackage for FusionAtlas v0.
October 12, 2008, Scott Morrison

Introduction

---text goes here---

Implementation

Start of package

Specify package dependencies:

BeginPackage["FusionAtlas`RemoteInterface`",{"FusionAtlas`","FusionAtlas`Bigraphs`","FusionAtlas`FindAllBigraphs`","FusionAtlas`FindGraphPartners`","FusionAtlas`Debugging`","DatabaseLink`","FusionAtlas`Java`","JLink`"}];

Usage messages

LookupObstructions::usage="";

LookupCanonicalForms;

RecordObstructions::usage="";

RequestObstructions::usage="";

ProcessObstructionsQueue;WorkOnObstructionsQueue;ClearObstructionsQueue;ObstructionsQueueLength;EstimateQueueCompletionTime;

RetrieveGraphs;LookupGraphs;TakeGraphs;

RecordCanonicalForms;

RecordFindGraphPartners;

GraphsNeedingPartners;

ReapplyTestToDatabase;

RecordRequestAllBigraphs;BigraphRequests;MaximalBigraphRequests;MaximalIncompleteBigraphRequests;DisplayBigraphRequests;

QueueExpression;

Internals

Begin["`Private`"];

(*SQLExecute[getConnection[], 
"DROP TABLE graphs"]*)

(*SQLExecute[getConnection[], 
"DROP TABLE canonical"]*)

(*SQLExecute[getConnection[], 
"CREATE TABLE graphs (graph CHAR(255) UNIQUE NOT NULL, rank INT, depth INT, dimension FLOAT, obstruction CHAR(255))"]*)

(*SQLExecute[getConnection[], 
"CREATE TABLE canonical (graph CHAR(255) UNIQUE NOT NULL, canonicalForm CHAR(255))"]*)

Off[JDBC::"error"]

createConnection[]:=(conn=OpenSQLConnection[JDBC["mysql","mysql.tqft.net/fusionatlas"],"Username"->"fusionatlas","Password"->"fusion", "UseConnectionPool" -> True];)

getConnection[]:=(If[!MatchQ[conn,_SQLConnection]∨!JavaObjectQ[conn[[2]]]∨conn[[2]]@isClosed[],createConnection[]];conn)

LookupObstructions[{}]:={}
LookupObstructions[graphs:{__String}]/;Length[graphs]≤2500:=
If[getConnection[]===$Failed,
{},
Module[{existingValues},
DebugPrint["Looking up obstructions for ",Length[graphs], " graphs in the remote database."];
existingValues=SQLSelect[getConnection[],"graphs",{"graph","obstruction"},SQLMemberQ[graphs,SQLColumn["graph"]]];
DebugPrint["Found ",Length[existingValues]," obstructions."];
{#[[1]],DeleteCases[{#[[2]]},Null]}&/@existingValues
]
]
LookupObstructions[graphs:{__GradedBigraph}]/;Length[graphs]≤2500:={GraphFromString[#[[1]]],#[[2]]}&/@LookupObstructions[GraphToString/@graphs]

LookupObstructions[graphs_List]/;Length[graphs]>2500:=Join@@(LookupObstructions/@Partition[graphs,2500,2500,{1,1},{}])

RecordCanonicalForms[{}]:=Null

RecordCanonicalForms[graphs_List]/;Length[graphs]>2500:=Union[Join@@(RecordCanonicalForms/@Partition[graphs,2500,2500,{1,1},{}])]

RecordCanonicalForms[graphs:{__String}]/;Length[graphs]≤2500:=
If[getConnection[]===$Failed,
CanonicalizeBigraph/@graphs,
Module[{existingValues,existingGraphs,toInsert,dataToInsert},
DebugPrint["Recording canonical forms for ",Length[graphs]," graphs"];
existingValues=SQLSelect[getConnection[],"canonical",{"graph","canonicalForm"},SQLMemberQ[graphs,SQLColumn["graph"]]];
existingGraphs=First/@existingValues;
DebugPrint["Found ",Length[existingGraphs]," existing values."];
toInsert=Complement[graphs,existingGraphs];
dataToInsert={#,CanonicalizeBigraph[#]}&/@toInsert;
If[Length[dataToInsert]>0,
DebugPrint["Uploading ",Length[dataToInsert]," values."];
SQLInsert[ getConnection[],"canonical", {"graph","canonicalForm"},dataToInsert];
];
Union[Last/@(existingValues~Join~dataToInsert)]
]
]

RecordCanonicalForms[graphs:{__GradedBigraph}]/;Length[graphs]≤2500:=GraphFromString/@RecordCanonicalForms[GraphToString/@graphs]

LookupCanonicalForms[{}]:={}

LookupCanonicalForms[graphs_List]/;Length[graphs]>2500:=Join@@(LookupCanonicalForms/@Partition[graphs,2500,2500,{1,1},{}])

LookupCanonicalForms[graphs:{__String}]/;Length[graphs]≤2500:=
If[getConnection[]===$Failed,
{},
Module[{result},
DebugPrint["Looking up canonical forms for ",Length[graphs]," graphs"];
result=SQLSelect[getConnection[],"canonical",{"graph","canonicalForm"},SQLMemberQ[graphs,SQLColumn["graph"]]];
DebugPrint["Found canonical forms for ",Length[result]," graphs"];
result
]
]

LookupCanonicalForms[graphs:{__GradedBigraph}]/;Length[graphs]≤2500:=Map[GraphFromString,LookupCanonicalForms[GraphToString/@graphs],{2}]

RecordObstructions[{},force_:False]:=Null
RecordObstructions[graphs0:{__GradedBigraph},force_:False]/;Length[graphs0]≤1000:=
If[getConnection[]===$Failed,
Null,
Module[{graphs,existingValues,existingGraphs,toInsert,dataToInsert,result},
(*graphs=RecordCanonicalForms[graphs0];*)
graphs=graphs0;
If[force,
existingGraphs={};,
existingValues=SQLSelect[getConnection[],"graphs",{"graph","obstruction"},SQLMemberQ[GraphToString/@graphs,SQLColumn["graph"]]];
existingGraphs=First/@existingValues;
];
toInsert=DeleteCases[graphs,g_/;MemberQ[existingGraphs,GraphToString[g]]];
(* calculate obstructions *)
KnownObstructions/@toInsert;
(* lookup again, so the SQLInsert doesn't fail because of pre-existing values -- often another queue worker will have done some of the graphs in the meantime *)
If[force,
existingGraphs={};,
existingValues=SQLSelect[getConnection[],"graphs",{"graph","obstruction"},SQLMemberQ[GraphToString/@graphs,SQLColumn["graph"]]];
existingGraphs=First/@existingValues;
];
toInsert=DeleteCases[toInsert,g_/;MemberQ[existingGraphs,GraphToString[g]]];
DebugPrint["Recording obstructions for ",Length[toInsert], " graphs in the remote database."];
dataToInsert=toInsert/.g_GradedBigraph:>{GraphToString[g],GraphRank[g],GraphDepth[g],NumericDimensionOfGenerator[g],If[Length[KnownObstructions[g]]>0,KnownObstructions[g][[1]],Null]};
If[Length[dataToInsert]>0,
If[force,SQLDelete[getConnection[],"graphs",SQLMemberQ[GraphToString/@graphs,SQLColumn["graph"]]];
];
result=SQLInsert[ getConnection[],"graphs", {"graph","rank","depth","dimension","obstruction"},dataToInsert];
];
]
]
RecordObstructions[graphs:{__String},force_:False]/;Length[graphs]≤1000:=RecordObstructions[GraphFromString/@graphs,force]

RecordObstructions[graphs_List,force_:False]/;Length[graphs]>1000:=RecordObstructions[#,force]&/@Partition[graphs,1000,1000,{1,1},{}];

Needs["JLink`"];

getQueueService[]:=If[!JavaObjectQ[queueService],queueService=JavaNew["com.xerox.amazonws.sqs2.QueueService","0D4BTQXQJ7SAKKQHF982","wQsXfibiPzfPFDZ84jWXIjNb9UfqnLh42+FHhqtp"],queueService]

numberOfQueues=2;

createQueue[k_]:=
Block[{$JavaExceptionHandler=#&},
queue[k]=getQueueService[]@getOrCreateMessageQueue["Obstructions-"<>ToString[k]];queue[k]=getQueueService[]@getOrCreateMessageQueue["https://queue.amazonaws.com:443/Obstructions-"<>ToString[k]];queue[k]@setQueueAttribute["VisibilityTimeout","3600"];
]

createQueue/@Range[numberOfQueues];

ObstructionsQueueLength[]:=(queue[#]@getApproximateNumberOfMessages[])&/@Range[numberOfQueues];

EstimateQueueCompletionTime[]:=Module[{starttime=AbsoluteTime[],startsize=Plus@@ObstructionsQueueLength[],time,size},
Print[startsize," queue items remain. ", "There are ",SQLExecute[getConnection[],"SELECT COUNT(graph) FROM graphs"][[1,1]]," rows in the graphs table. "];
While[True,
size=Plus@@ObstructionsQueueLength[];
Print[size," queue items remain. ", "There are ",SQLExecute[getConnection[],"SELECT COUNT(graph) FROM graphs"][[1,1]]," rows in the graphs table. ","Completion expected in ",If[startsize==size,∞,((AbsoluteTime[]-starttime)/(startsize-size))size], " seconds."];
Pause[10]
];
]

RequestObstructions[{}]:=Null

RequestObstructions[graphs:{__GradedBigraph}]:=RequestObstructions[GraphToString/@graphs]

RequestObstructions[graphStrings0:{__String},queueNumber_:1]:=
Module[{messageBody,result,length,set,graphStrings=graphStrings0},
If[MatchQ[queue[queueNumber], $Failed | _$Failed],
createQueue[queueNumber]
];
DebugPrint["Putting ",Length[graphStrings], " graphs on the obstruction queue."];
While[Length[graphStrings]>0,
length=2;
set=TakeWhile[graphStrings,(length+=(StringLength[#]+2))<3500&];
graphStrings=Drop[graphStrings,Length[set]];
messageBody=ToString[set];
DebugPrint["Sending message containing ",Length[set], " graphs."];
Block[{$JavaExceptionHandler=(createQueue[queueNumber];DebugPrint["Java exception: ",#3])&},
result=queue[queueNumber]@sendMessage[messageBody];
];
DebugPrint[result];
If[MatchQ[result,$Failed|_$Failed],
DebugPrint["Failed to send message to the queue..."];
createQueue[queueNumber];
];
];
]

SetAttributes[QueueExpression,HoldFirst]

QueueExpression[x_,queueNumber_Integer:1]:=Module[{messageBody},
messageBody=ToStringHeld[x];
Block[{$JavaExceptionHandler=(createQueue[queueNumber];DebugPrint["Java exception: ",#3])&},
queue[queueNumber]@sendMessage[messageBody]
]
]

MatrixStringPattern=((((DigitCharacter..)~~"x")...~~(DigitCharacter..))~~"p")...~~(((DigitCharacter..)~~"x")...~~(DigitCharacter..));

GraphStringPattern=("gbg"|"gg")~~(MatrixStringPattern..~~"v")...~~MatrixStringPattern;

SetAttributes[ToStringHeld,HoldFirst]

ToStringHeld[e_]:=StringTake[ToString[HoldForm[e],InputForm],{10,-2}]

GlobalToExpression[S_String]:=Module[{oldContext=$Context,result},
$Context="Global`";
result=ToExpression[S];
$Context=oldContext;
result
]

ProcessObstructionsQueue[queueNumber_:1]:=
Module[{message,messageBody,graphs={}},
If[MatchQ[queue[queueNumber], $Failed | _$Failed],
createQueue[queueNumber]
];
Block[{$JavaExceptionHandler=(createQueue[queueNumber];DebugPrint["Java exception: ",#3])&},
message=queue[queueNumber]@receiveMessage[];
If[MatchQ[message,$Failed|_$Failed],
DebugPrint["Failed to receive message."];
];
If[message=!=Null,
DebugPrint["Received a message from queue ",queueNumber];
messageBody=message@getMessageBody[];
DebugPrint[messageBody];
Switch[messageBody,
S_/;StringMatchQ[S,
"{"~~(GraphStringPattern~~", ")...~~GraphStringPattern~~"}"],
DebugPrint["Just contains a list of graphs; recording obstructions..."];
graphs=StringSplit[StringTake[messageBody,{2,-2}],", "];
DebugPrint["Beginning work on ",Length[graphs], " graphs"];
RecordObstructions[graphs];,
S_/;StringMatchQ[S,
"RecordObstructions[{"~~("\""~~GraphStringPattern~~"\""~~", ")...~~"\""~~GraphStringPattern~~"\""~~"}"],
DebugPrint["Looks like a request to record obstructions; starting..."];
GlobalToExpression[messageBody];,
S_/;StringMatchQ[S,"RequestAllBigraphs["~~___~~"]"],
GlobalToExpression[messageBody];,
_,Print["Warning! Unexpected message arrived on the queue; ignoring."];
];
DebugPrint["Finished work, deleting message from the queue."];
queue[queueNumber]@deleteMessage[message];
DebugPrint["Deleted message from queue."];
];
];
Length[graphs]
]

WorkOnObstructionsQueue[]:=Module[{},
While[True,
While[ProcessObstructionsQueue[1]>0,{}];
If[ObstructionsQueueLength[][[2]]<1000,
If[RandomReal[]<0.01,
If[RandomReal[]<0.4,
RequestMoreBigraphs[2],
RerequestSomeBigraphs[2]
];
];
];
If[ProcessObstructionsQueue[2]==0,Pause[10]];
]
]

RerequestSomeBigraphs[k_Integer:1]:=Module[{requests,norm,rank,seed},
requests=MaximalIncompleteBigraphRequests[];
requests=DeleteCases[requests,{___,0}];
If[Length[requests]>0,
{norm,rank,seed}=Take[RandomChoice[SortBy[requests,#[[6]]&]],3];
DebugPrint["About to run RequestAllBigraphs[",norm,", ",rank,", ",DisplayBigraph[seed],"]"];
RequestAllBigraphs[norm,rank,seed,k]
]
]

ClearObstructionsQueue[k_:1]:=Block[
{$JavaExceptionHandler=(DebugPrint["Java exception: ",#3])&},
queue[k]@deleteQueue[];
createQueue[k];
]

SetAttributes[RetrieveGraphs,{HoldAll}]

RetrieveGraphs[condition_]:=GraphFromString/@First/@SortBy[SQLSelect[getConnection[],"graphs",{"graph","dimension"},ReleaseHold[Hold[condition]/.{"seed"==g_GradedBigraph:>SQLStringMatchQ[SQLColumn["graph"],GraphToString[g]<>"v%"],"obstruction"==S_String:>SQLStringMatchQ[SQLColumn["obstruction"],S],S_String:>SQLColumn[S],α_?NumericQ:>N[α]}]],#[[2]]&]

LookupGraphs[{}]:={}

LookupGraphs[graphs:{__GradedBigraph}]/;Length[graphs]≤2500:=LookupGraphs[GraphToString/@graphs]/.{g_String,rank_Integer,depth_Integer,dimension_,obstruction:(_String|Null)}:>{GraphFromString[g],rank,depth,dimension,obstruction}

LookupGraphs[graphs:{__String}]/;Length[graphs]≤2500:=
If[getConnection[]===$Failed,
{},
Module[{existingValues},
DebugPrint["Looking up ",Length[graphs], " graphs in the remote database."];
existingValues=SQLSelect[getConnection[],"graphs",SQLMemberQ[graphs,SQLColumn["graph"]]];
DebugPrint["Found ",Length[existingValues]," graphs."];
existingValues
]
]

LookupGraphs[graphs_List]/;Length[graphs]>2500:=Join@@(LookupGraphs/@Partition[graphs,2500,2500,{1,1},{}])

TakeGraphs[k_Integer]:=TakeGraphs[{1,k}]

TakeGraphs[{k_Integer,l_Integer}]/;l≥k:=Flatten[SQLExecute[getConnection[],"SELECT graph from graphs LIMIT "<>ToString[k]<>","<>ToString[l-k+1]]]

RecordFindGraphPartners[graphs0:{__GradedBigraph}]:=RecordFindGraphPartners[GraphToString/@graphs0]

RecordFindGraphPartners[graphs0:{__String}]:=Module[{graphs,data,existingData,dataToUpload,graphsToDelete},
graphs=Union[CanonicalizeBigraph/@graphs0];
DebugPrint["Recording graph partners for ",Length[graphs]," graphs."];
data={#[[1]],FindGraphPartnersTimeConstraint[#[[2]]],ToString[GraphToString/@LazyFindGraphPartners[#[[2]]]]}&/@({#,GraphFromString[#]}&/@graphs);
existingData=SQLSelect[getConnection[],"partners",{"graph","timeconstraint","partners"},SQLMemberQ[graphs,SQLColumn["graph"]]];
dataToUpload=Complement[data,existingData];
DebugPrint["... new information for ",Length[dataToUpload], " graphs."];
graphsToDelete=Intersection[First/@existingData,First/@dataToUpload];
DebugPrint["... replacing data for ",Length[graphsToDelete]," graphs."];
If[Length[graphsToDelete]>0,
SQLDelete[getConnection[],"partners",SQLMemberQ[graphsToDelete,SQLColumn["graph"]]];
];
If[Length[dataToUpload]>0,
SQLInsert[getConnection[],"partners",{"graph","timeconstraint","partners"},dataToUpload];
];
]

RecordFindFusionAlgebras[graphs0:{__GradedBigraph}]:=RecordFindGraphPartners[GraphToString/@graphs0]

RecordFindFusionAlgebras[graphs0:{__String}]:=Module[{graphs,data,existingData,dataToUpload,graphsToDelete},
graphs=Union[CanonicalizeBigraph/@graphs0];
DebugPrint["Recording fusion algebras for ",Length[graphs]," graphs."];
data={#[[1]],FindFusionAlgebrasTimeConstraint[#[[2]]],ToString[LazyFindFusionAlgebras[#[[2]]]]}&/@({#,GraphFromString[#]}&/@graphs);
existingData=SQLSelect[getConnection[],"fusionalgebras",{"graph","timeconstraint","partners"},SQLMemberQ[graphs,SQLColumn["graph"]]];
dataToUpload=Complement[data,existingData];
DebugPrint["... new information for ",Length[dataToUpload], " graphs."];
graphsToDelete=Intersection[First/@existingData,First/@dataToUpload];
DebugPrint["... replacing data for ",Length[graphsToDelete]," graphs."];
If[Length[graphsToDelete]>0,
SQLDelete[getConnection[],"partners",SQLMemberQ[graphsToDelete,SQLColumn["graph"]]];
];
If[Length[dataToUpload]>0,
SQLInsert[getConnection[],"partners",{"graph","timeconstraint","partners"},dataToUpload];
];
]

GraphsNeedingPartners[t_:0]:=First/@SortBy[SQLSelect[getConnection[],{"graphs","partners"},{{"graphs","graph"},{"graphs","dimension"},{"graphs","obstruction"},{"partners","timeconstraint"},{"partners","partners"}},SQLColumn[{"graphs","obstruction"}]==Null∧SQLColumn[{"partners","partners"}]=="$Failed"∧SQLColumn[{"partners","timeconstraint"}]≥t∧SQLColumn[{"graphs","graph"}]==SQLColumn[{"partners","graph"}]],#[[2]]&]

ReapplyTestToDatabase[test_]:=RecordObstructions[Cases[RetrieveGraphs["obstruction"==Null],g_/;!test[g]],True]

RecordRequestAllBigraphs[dimension_?NumericQ,rank_Integer,seed_GradedBigraph,allowed_Integer,disallowed_Integer,unknown_Integer]:=RecordRequestAllBigraphs[ToString[dimension],rank,GraphToString[seed],allowed,disallowed,unknown]

RecordRequestAllBigraphs[dimension_String,rank_Integer,seed_String,allowed_Integer,disallowed_Integer,unknown_Integer]:=
Module[{},
If[Length[SQLSelect[getConnection[],"classification",{"dimension","rank","seed"},SQLColumn["dimension"]==dimension∧SQLColumn["rank"]==rank∧SQLColumn["seed"]==seed]]==0,
SQLInsert[getConnection[],"classification",{"dimension","rank","seed","allowed","disallowed","unknown"},{dimension,rank,seed,allowed,disallowed,unknown}];,
SQLUpdate[getConnection[],"classification",{"allowed","disallowed","unknown"},{allowed,disallowed,unknown},SQLColumn["dimension"]==dimension∧SQLColumn["rank"]==rank∧SQLColumn["seed"]==seed];
]
]

BigraphRequests[]:=
SortBy[(SQLSelect[getConnection[],"classification"]/.{dimension_String,rank_,seed_,allowed_,disallowed_,unknown_}:>{ToExpression[dimension],rank,GraphFromString[seed],allowed,disallowed,unknown}),{NumericDimensionOfGenerator[#[[3]]],#[[1]],#[[3]]}&]

MaximaOfPartialOrdering[list_List,f_]:=MaximaOfPartialOrdering[{},list,f]
MaximaOfPartialOrdering[maxima_List,{},f_]:=maxima
MaximaOfPartialOrdering[maxima_List,{first_,rest___},f_]:=Module[{},
If[Or@@(f[first,#]&/@maxima),
MaximaOfPartialOrdering[maxima,{rest},f],
MaximaOfPartialOrdering[{first}~Join~DeleteCases[maxima,c_/;f[c,first]],{rest},f]
]
]

MaximalIncompleteBigraphRequests[]:=SortBy[MaximaOfPartialOrdering[BigraphRequests[],#1[[1]]≤#2[[1]]∧#1[[2]]≤#2[[2]]∧#1[[3]]===#2[[3]]&],{NumericDimensionOfGenerator[#[[3]]],#[[1]],#[[3]]}&]

MaximalBigraphRequests[]:=SortBy[MaximaOfPartialOrdering[BigraphRequests[],#1[[1]]≤#2[[1]]∧#1[[2]]≤#2[[2]]∧#1[[3]]===#2[[3]]∧#1[[6]]≥#2[[6]]&],{NumericDimensionOfGenerator[#[[3]]],#[[1]],#[[3]]}&]

DisplayBigraphRequests[]:=Split[BigraphRequests[],#1[[3]]===#2[[3]]&]/.{values:{{_,_,seed_GradedBigraph,_,_,_}..}:>{seed,Drop[#,{3}]&/@values}}/.g_GradedBigraph:>DisplayBigraph[g]//TableForm

End

End[];

End of package

EndPackage[];