<commit_before>#! /usr/bin/env perl
#
# rules-to-implications.pl
#
# Convert Relex framing rule files to OpenCog ImplicationLinks
#
# This perl script takes, as input, implication rules, in the IF .. THEN
# format used by the RelEx framing code, and generates equivalent
# OpenCog ImplicationLinks.
#
# To use, do the following:
#
#    cat some-rule-file.txt | ./rules-to-implications.pl "my-rules"
#
# This perl script implements a very simple parser. Some day in the future,
# it would proably make sense to re-write this in terms of lex & yacc. Maybe.
#
# Copyright (c) 2009 <NAME> <<EMAIL>>
# Created in January, March 2009.
#

use strict;

my %word_map = ();

# --------------------------------------------------------------------
# parse_clause -- Split a clause into it's parts. 
#
# A clause is assumed to be either a triple, such as "blah(foo, bar)"
# or a double, such as "ding ( dong )". The parens are required. The
# whitespace is optional. Its a triple, if it has a comma, else its a
# double. Triples return a list of four items: the triple, plus the
# rest of the line (i.e. trailing characters). Doubles only return a
# list of three things.
#
sub parse_clause
{
	my ($clause) = @_;

	# Ditch the white space, this'll make matching easier.
	# XXXX $clause =~ s/\s*//g;
	# No it won't, since it'll trash quoted string literals.

	# Pull the three parts out of the clause.
	# The pattern matches "blah(ding,dong)"
	$clause =~ m/^\s*([\$\!%\:\&\-\w]+)\s*\(\s*([\$%#\"\-\w\s]+)\s*\,\s*([\$%#\"\-\w\s]+)\s*\)(.*)$/;
	my $pred = $1;
	my $item1 = $2;
	my $item2 = $3;
	my $rest = $4;

	my @parts = ();

	# If the above pattern-match failed, then its a double.
	# Note that, sometimes when the match fails, $1 contains garbage.
	# This seems to be a perl bug. But $2 and $3 will still be empty
	if ($pred eq "" || $item1 eq "" || $item2 eq "")
	{
		# The pattern matches "blah(ding)"
		$clause =~ m/^\s*([\$!%\-\w]+)\s*\(\s*([\$%#\-\w]+)\s*\)(.*)$/;
		$pred = $1;
		$item1 = $2;
		$rest = $3;

		# Create the list only is the parse succeeded.
		if ($pred ne "")
		{
			@parts = ($pred, $item1, $rest);
		}
	}
	else
	{
		@parts = ($pred, $item1, $item2, $rest);
	}
	@parts;
}

# --------------------------------------------------------------------
sub get_word_id
{
	my ($item) = @_;
	my $id = $word_map{$item};
	if (!defined $id)
	{
		my $cnt = $word_map{"ccc-cnt-ccc"};
		$cnt += 1;
		$word_map{"ccc-cnt-ccc"} = $cnt;

		$id = "\$word-instance-$cnt";
		$word_map{$item} = $id;
	}
	$id;
}

# --------------------------------------------------------------------
# print a variable or a word instance
# The word-instance is printed as a variable; this is joined
# to a particular word, later on, by a LemmaLink.
#
sub print_var_or_word_instance
{
	my ($item, $indent) = @_;

	if ($item =~ /^\$/)
	{
		print "$indent(VariableNode \"$item\")\n";
	}
	else
	{
		# Dang, not a word node, but some unknown word-instance node.
		# print "$indent(WordNode \"$item1\")\n";
		my $id = get_word_id ($item);
		print "$indent(VariableNode \"$id\")\n";
	}
}

# --------------------------------------------------------------------
# Print a triple-style clause. 
# Expects as input a clause, for example, "_subj(be,$var0)", and 
# some whitespace to indent by. Prints, as output, the standard
# OpenCog EvaluationLink equivalent of the clause.
#
sub print_triple_clause
{
	my ($clause, $indent) = @_;

	# Pull the three parts out of the clause.
	my ($pred, $item1, $item2) = parse_clause($clause);

	# Print a copy of the original clause for reference
	print "$indent;; $clause\n";
	print "$indent(EvaluationLink (stv 1.0 1.0)\n";
	if ($pred =~ /^\$/)
	{
		print "$indent   (VariableNode \"$pred\")\n";
	}
	else
	{
		print "$indent   (DefinedLinguisticRelationshipNode \"$pred\")\n";
	}

	print "$indent   (ListLink\n";

	print_var_or_word_instance($item1, $indent . "      ");
	print_var_or_word_instance($item2, $indent . "      ");

	print "$indent   )\n";
	print "$indent)\n";
}

# --------------------------------------------------------------------
# Print a triple-style clause. 
# Expects as input a clause, for example, "_subj(be,$var0)", and 
# some whitespace to indent by. Prints, as output, the standard
# OpenCog EvaluationLink equivalent of the clause.
#
sub print_double_clause
{
	my ($clause, $indent) = @_;

	# Pull the two parts out of the clause.
	my ($pred, $item1) = parse_clause($clause);

	# strip out the -FLAG at the end
	$pred =~ s/-FLAG//;
	$pred =~ tr/[A-Z]/[a-z]/;

	# Print a copy of the original clause for reference
	print "$indent;; $clause\n";
	print "$indent(InheritanceLink (stv 1.0 1.0)\n";
	print_var_or_word_instance($item1, $indent . "   ");
	print "$indent   (DefinedLinguisticConceptNode \"$pred\")\n";
	print "$indent)\n";
}

# --------------------------------------------------------------------
# Print a clause. 
# Expects as input a clause, for example, "_subj(be,$var0)", and <commit_msg>start slotting in special-case function handling.<commit_after>#! /usr/bin/env perl
#
# rules-to-implications.pl
#
# Convert Relex framing rule files to OpenCog ImplicationLinks
#
# This perl script takes, as input, implication rules, in the IF .. THEN
# format used by the RelEx framing code, and generates equivalent
# OpenCog ImplicationLinks.
#
# To use, do the following:
#
#    cat some-rule-file.txt | ./rules-to-implications.pl "my-rules"
#
# This perl script implements a very simple parser. Some day in the future,
# it would proably make sense to re-write this in terms of lex & yacc. Maybe.
#
# Copyright (c) 2009 <NAME> <<EMAIL>>
# Created in January, March 2009.
#

use strict;

my %word_map = ();

# --------------------------------------------------------------------
# parse_clause -- Split a clause into it's parts. 
#
# A clause is assumed to be either a triple, such as "blah(foo, bar)"
# or a double, such as "ding ( dong )". The parens are required. The
# whitespace is optional. Its a triple, if it has a comma, else its a
# double. Triples return a list of four items: the triple, plus the
# rest of the line (i.e. trailing characters). Doubles only return a
# list of three things.
#
sub parse_clause
{
	my ($clause) = @_;

	# Ditch the white space, this'll make matching easier.
	# XXXX $clause =~ s/\s*//g;
	# No it won't, since it'll trash quoted string literals.

	# Pull the three parts out of the clause.
	# The pattern matches "blah(ding,dong)"
	$clause =~ m/^\s*([\$\!%\:\&\-\w]+)\s*\(\s*([\$%#\"\-\w\s]+)\s*\,\s*([\$%#\"\-\w\s]+)\s*\)(.*)$/;
	my $pred = $1;
	my $item1 = $2;
	my $item2 = $3;
	my $rest = $4;

	my @parts = ();

	# If the above pattern-match failed, then its a double.
	# Note that, sometimes when the match fails, $1 contains garbage.
	# This seems to be a perl bug. But $2 and $3 will still be empty
	if ($pred eq "" || $item1 eq "" || $item2 eq "")
	{
		# The pattern matches "blah(ding)"
		$clause =~ m/^\s*([\$\&!%\-\w]+)\s*\(\s*([\$%#\-\w]+)\s*\)(.*)$/;
		$pred = $1;
		$item1 = $2;
		$rest = $3;

		# Create the list only is the parse succeeded.
		if ($pred ne "")
		{
			@parts = ($pred, $item1, $rest);
		}
	}
	else
	{
		@parts = ($pred, $item1, $item2, $rest);
	}
	@parts;
}

# --------------------------------------------------------------------
sub get_word_id
{
	my ($item) = @_;
	my $id = $word_map{$item};
	if (!defined $id)
	{
		my $cnt = $word_map{"ccc-cnt-ccc"};
		$cnt += 1;
		$word_map{"ccc-cnt-ccc"} = $cnt;

		$id = "\$word-instance-$cnt";
		$word_map{$item} = $id;
	}
	$id;
}

# --------------------------------------------------------------------
# print a variable or a word instance
# The word-instance is printed as a variable; this is joined
# to a particular word, later on, by a LemmaLink.
#
sub print_var_or_word_instance
{
	my ($item, $indent) = @_;

	if ($item =~ /^\$/)
	{
		print "$indent(VariableNode \"$item\")\n";
	}
	else
	{
		# Dang, not a word node, but some unknown word-instance node.
		# print "$indent(WordNode \"$item1\")\n";
		my $id = get_word_id ($item);
		print "$indent(VariableNode \"$id\")\n";
	}
}

# --------------------------------------------------------------------
# Print a triple-style clause. 
# Expects as input a clause, for example, "_subj(be,$var0)", and 
# some whitespace to indent by. Prints, as output, the standard
# OpenCog EvaluationLink equivalent of the clause.
#
sub print_triple_clause
{
	my ($clause, $indent) = @_;

	# Pull the three parts out of the clause.
	my ($pred, $item1, $item2) = parse_clause($clause);

	# Print a copy of the original clause for reference
	print "$indent;; $clause\n";
	print "$indent(EvaluationLink (stv 1.0 1.0)\n";
	if ($pred =~ /^\$/)
	{
		print "$indent   (VariableNode \"$pred\")\n";
	}
	else
	{
		print "$indent   (DefinedLinguisticRelationshipNode \"$pred\")\n";
	}

	print "$indent   (ListLink\n";

	print_var_or_word_instance($item1, $indent . "      ");
	print_var_or_word_instance($item2, $indent . "      ");

	print "$indent   )\n";
	print "$indent)\n";
}

# --------------------------------------------------------------------
# Handle a function
#
sub print_function
{
	my ($clause, $indent) = @_;
	print "$indent;; $clause\n";
print "heyyyy\n";
}

# --------------------------------------------------------------------
# Print a double-style clause. 
# Expects as input a clause, for example, "DEFINITE-FLAG(ball)", and 
# some whitespace to indent by. Prints, as output, the standard
# OpenCog InheritanceLink equivalent of the clause.
#
sub print_double_clause
{
	my ($clause, $indent) = @_;

	# Pull the two parts out of the clause.
	my ($pred, $item1) = parse_clause($clause);

	if ($clause =~ /\&/)
	{
		print_function @_;
		return;
	}

	# strip out the -FLAG at the end, and lower-case the whole string
	$pred =~ s/-FLAG//;
	$pred =~ tr/[A-Z]/[a-z]/;

	# Print a copy of the original clause for reference
	print "$indent;; $clause\n";
	print "$indent(InheritanceLink (stv 1.0 1.0)\n";
	print_var_or_word_instance($item1, $indent . "   ");
	print "$indent   (DefinedLinguisticConceptNode \"$pred\")\n";
	print "$indent)\n";
}

# --------------------------------------------------------------------
# Print a clause. 
# Expects as input a clause, for example, "_subj(be,$var0)", and 
{'fraction_non_alphanumeric': 0.2451904201020809, 'fraction_numerical': 0.008735767569689832, 'mean_word_length': 2.373841059602649, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 9, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6192219', 'n_tokens_mistral': 3651, 'n_tokens_neox': 3466, 'n_words': 1119}