helper.pl

• package main
  • readxnetwork
  • read_network_as_graph
  • readNodeLabels
  • read_network_as_line
  • read_file
  • write_file
  • read_var_file
  • read_inc_file
  • loadWorkIds
  • load_image_urls
  • load_year_range
  • load_types
  • load_node_overlap
  • low_overlap
  • high_overlap
  • very_high_overlap
  • good_overlap
  • link_to_web
  • load_networks
  • to_consider
  • load_aliases
  • normalized_name
  • load_actorids
  • link_to_actor
  • link_to_actor_id
  • uri_for_actor
  • link_to_network
  • uri_for_network
  • link_to_network_format
  • id_from_link_to_network
  • file_of_network
  • dir_of_network
  • linktext_of_network
  • piechart
• EOF

# This work is licensed under the Creative Commons
# Attribution-ShareAlike 3.0 Unported License. To view a copy of this
# license, visit http://creativecommons.org/licenses/by-sa/3.0/ or send
# a letter to Creative Commons, PO Box 1866, Mountain View, CA 94042,
# USA. 
# Reference: http://www.lombardinetworks.net
# (C) Robert Tolksdorf, http://www.robert-tolksdorf.de
use Graph::Directed;

$doc_root="/vhome/lombardinetworks.net/htdocs/";

# reading networks --------------------------------------------------
sub readxnetwork {
    $networkid=$workid{$_[0]};
    $network_file=&file_of_network($networkid);
    $network_link=&link_to_network($networkid);
    open(F, "<", $network_file);
    while ($line=<F>) {
	if ($line=~/^\s*\<node id=\".*\"/) {
	     $line2="";
	     $tolist=0;
	     while (!($line2=~/^\s*\<\/node/)) {
		$line2=<F>;
	      	if (($line2=~/\s*<att name=\"type\" value=\"http:\/\/www.lombardinetworks.net\/lombardi.owl#Institution\"/) ||
	      	    ($line2=~/\s*<att name=\"type\" value=\"http:\/\/www.lombardinetworks.net\/lombardi.owl#Person\"/)) {
	      	    $tolist=1;
	      	}
		if ($line2=~/\s*<att name=\"name\" value=\"(.*)\" type/) {
		    $label=$1;
		    # normalize
		    $label=~s/\&amp;/\&/g;
		    $label=~s/\&quot;/\"/g;
		}
	     }
	     if ($tolist) {
		 if ($cast{$label} ne "") {
		     $cast{$label}.=" | ";
		 }
		 $cast{$label}.=$network_link;
		 # get the array of networks with that actor
# 		 print "$label is in $networkid\n";
		 if (defined $actor_in_network{$label}) {
		     my $networks=$actor_in_network{$label};
		     # print "For $label I find\n";
		     # print Dumper @$networks;
		     push @$networks, $networkid;
		     # print "I store ($_[0])\n";
		     # if ($networkid == 1049) {
      		     # 	 print($label);
    		     # }
		     
 		     # print Dumper @$networks;
		     $actor_in_network{$label}=\@networks;
		 } else {
#		     my $first=($workid{$_[0]});
#		     $actor_in_network{$label}=\@first;
		     my $first=[$workid{$_[0]}];
		     $actor_in_network{$label}=$first;
		 }
		 # append this networks id
		 
	     }
	}
    }
    close(F);
#     print "end with $_[0]\n";

}

sub read_network_as_graph {
    # create an empty graph
    my $g = Graph::Directed->new;
    # open the file
    open(F, "<", &file_of_network($_[0]));
    # iterate though all lines
    while ($line=<F>) {
	# do we read a node?
	if ($line=~/^\s*\<node id=\"(.*)\"/) {
	    # create the node from the id
	    $id=$1;
	    $g->add_vertex($id);
	    $line2="";
	    $tolist=0;
	    # as long as we do not read the closing node tag...
	     while (!($line2=~/^\s*\<\/node/)) {
		 # get next line
		 $line2=<F>;
		 # if we get the name attribute
		 if ($line2=~/\s*<att name=\"name\" value=\"(.*)\" type/) {
		     my $label=$1;
		     # normalize it
		     $label=~s/\&amp;/\&/g;
		     $label=~s/\&quot;/\"/g;
		     # store name as node attribute
		     $g->set_vertex_attribute($id,"name",$label);
		 } elsif ($line2=~/\s*<att name=\"type\" value=\"(.*)\" type/) { # the type attribute
		     # store type as node attribute
		     $g->set_vertex_attribute($id,"type",$1);
		 }
		 # no other attributes exist
	     }
	} elsif ($line=~/^\s*\<edge source=\"(.*)\" target=\"(.*)\"/) { # do we read an edge
	    # store the edge
	    my $s=$1;
	    my $t=$2;
	    $g->add_edge($s,$t);
	    $line2="";
	     # as long as we do not read the closing node tag...
	     while (!($line2=~/^\s*\<\/edge/)) {
		 # get next line
		 $line2=<F>;
		 # if we get the amount attribute
		 if ($line2=~/\s*<att name=\"amount\" value=\"(.*)\" type/) {
		     # store the amount attribute of the edge
		     $g->set_edge_attribute($s,$t,"amount",$1);
		 } elsif ($line2=~/\s*<att name=\"type\" value=\"(.*)\" type/) { # the type attribute
		     # store the type attribute of the edge
		     $g->set_edge_attribute($s,$t,"type",$1);
		 }
	     }
	}
    }
    close(F);
    return $g;    
}

sub readNodeLabels {
    @labelList = ();
    open(F, "<", &file_of_network($_[0]));
    while ($line=<F>) {
	# do we read a node?
	if ($line=~/^\s*\<node id=\"(.*)\"/) {
	     $line2="";
	     $tolist=0;
	     
	     # as long as we do not read the closing node tag...
	     while (!($line2=~/^\s*\<\/node/)) {
		 # get line
		 $line2=<F>;
		 # if we get the name attribute
		 if ($line2=~/\s*<att name=\"name\" value=\"(.*)\" type/) {
		     $label=$1;
		     $label=~s/\&amp;/\&/g;
		     $label=~s/\&quot;/\"/g;
		     push @labelList, $label;
		 }
	     }
	}
    }
    close(F);
    return @labelList; # Return the array
}


# read everything a one long string
sub read_network_as_line {
    return &read_file(&file_of_network($_[0]));
}


# reading other files --------------------------------------------------

sub read_file{
    # get the complete content of a file
    my $line;
    open(I, "<", $_[0]);
    {    local $/;    # slurp mode
	 $line= <I>;
    }
    close I;
    return $line;
}

sub write_file{
    # write text to a file
    my $line;
    open(O, ">", $_[0]);
    print O $_[1];
    close O;
}

# read_var_file(name)
sub read_var_file {
    return (&read_file("$doc_root/bin/var/$_[0].var"));
}

# read_inc_file(name)
sub read_inc_file {
    return (&read_file("$doc_root/bin/inc/$_[0].inc"));
}

sub loadWorkIds {
    # get all numbers and names
    # $line=&read_var_file("workids");
    # %workid = %{ eval $line };
    %workid = %{ eval &read_var_file("workids") };
    %idwork = reverse %workid;
}


sub load_image_urls {
    # get all numbers and urls
#    $line=&read_file($doc_root."bin/var/imagelinks.var");
    %image_url = %{ eval &read_var_file("imagelinks") };
}

sub load_year_range {
    # get all numbers and ranges
    %year_range = %{ eval &read_var_file("year-range") };
}

sub load_types {
    @edgetype=@{eval &read_var_file("edgetypes")};
    @nodetype=@{eval &read_var_file("nodetypes")};
}

sub load_node_overlap {
    @node_overlap=@{eval &read_var_file("overlaps")};
}

# to few overlaps for similarity
sub low_overlap {
    return ($_[0]!=0 &&!&good_overlap);
}

# enough overlaps for at least some similarity
sub high_overlap {
    return ($_[0]>.2);

}

# enough overlaps for substantial similarity
sub very_high_overlap {
    return $_[0]>.4;
}

# enough but not very high similarity
sub good_overlap {
    return (&high_overlap($_[0])) && !&very_high_overlap($_[0]);
}


sub link_to_web {
    return("<a href=\"$_[0]\">$_[1]</a>");
}

sub load_networks {
    # read the xgmml files
    foreach $key (keys %workid) {
	&readxnetwork($key);
    }
}

# true if a node label is relevant (eg. blank nodes are not)
sub to_consider {
    return (!(($_[0]=~/\[\d*\]/)      # ignore blank [1] nodes (circled)
	      || ($_[0]=~/^\(\d*\)$/) # ignore blank (2) nodes (uncircled)
	      || ($_[0] eq "?")     # ignore ? nodes
	      || ($_[0] eq "+")     # ignore + nodes
	      || ($_[0]=~/.*\/\d$/) # ignore "xxx/2" nodes that occur multiple times in one drawing
	    ));
}

sub load_aliases {
    $line=
    %alias = %{ eval &read_var_file("aliases") };
}

# If argument is an alias name, return normalized name, otherwise unchanged
sub normalized_name {
    if ($alias{$_[0]}) {
	return $alias{$_[0]};
    } else {
	return $_[0];
    }
}


sub load_actorids {
    # read the complete (generated) array of actor ids
#    $line=&read_file($doc_root."bin/actorids");
    # store it
    %actorid = %{ eval &read_var_file("actorids") };
    %idactor = reverse %actorid;
}

sub link_to_actor {
    # linktext is name of actor, link is generated page 
    return "<a href=\"http://lombardinetworks.net/actor/$actorid{$_[0]}/\">$_[0]</a>";
}

sub link_to_actor_id {
    # linktext is name of actor, link is generated page 
    return "<a href=\"http://lombardinetworks.net/actor/$_[0]/\">$idactor{$_[0]}</a>";
}

sub uri_for_actor {
    # linktext is name of URL of the link, link is generated page 
    return "<a href=\"http://lombardinetworks.net/actor/$_[0]\">http://lombardinetworks.net/actor/$_[0]</a>";
}


# return an html link to a network from id TODO: change to dir!
sub link_to_network {
    # linktext is name of the work, link is generated page 
#    return "<a href=\"http://lombardinetworks.net/network/$_[0]/$_[0].xgmml\">$idwork{$_[0]}</a>";
    return "<a href=\"http://lombardinetworks.net/network/$_[0]/\">$idwork{$_[0]}</a>";
}

sub uri_for_network {
    # linktext is name of the work, link is generated page 
    return "<a href=\"http://lombardinetworks.net/network/".$workid{$_[0]}."/\">http://lombardinetworks.net/network/".$workid{$_[0]}."/</a>";
}

# return an html link to a network TODO: change to dir!
sub link_to_network_format {
    # linktext is name of the work, link is generated page 
    return "<a href=\"http://lombardinetworks.net/network/$_[0]/$_[0].$_[1]\">$_[1]</a>";
}

# extract id from a link to a network.xgmml
sub id_from_link_to_network {
    $_[0]=~/<a href=\"(.*)\"/;
    $1=~/http:\/\/lombardinetworks\.net\/network\/(.*)\//;
    return $1;
}

# return a representation of the network id    
sub file_of_network {
    return $doc_root."network/".$_[0]."/".$_[0].".xgmml";
}

# return the directory for an id
sub dir_of_network {
    return $doc_root."network/".$_[0]."/";
}

# given an html-link, return the linktext    
sub linktext_of_network {
    $_[0] =~/<a.*>(.*)<\/a>/;
    return $1;
}
# visualization --------------------------------------------------

# code for a pie chart id,title,data. see https://www.w3schools.com/howto/tryit.asp?filename=tryhow_google_pie_chart
sub piechart {
    return ("<span id=\"$_[0]\"></span>".
	    # loader loaded in header, not for every chart
#	    '<script type="text/javascript" src="https://www.gstatic.com/charts/loader.js"></script>'.
	    '<script type="text/javascript">'.
	    "google.charts.load('current', {'packages':['corechart']});".
	    "google.charts.setOnLoadCallback(drawChart);".
	    "function drawChart() {".
	    "var data = google.visualization.arrayToDataTable([$_[2]]);\n".
	    # some options
	    "var options = {'title':'$_[1]', 'width':400, 'height':250, backgroundColor: 'transparent',legend:{position: 'top', maxLines: 3}};".
	    "var chart = new google.visualization.PieChart(document.getElementById('$_[0]'));".
	    "chart.draw(data, options);}</script>");
}

1;