summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xbin/merge.py1053
-rwxr-xr-xbin/mimosawatch24
-rw-r--r--lib/AspectC/Repo/Function.pm55
-rw-r--r--lib/FLAT.pm197
-rw-r--r--lib/FLAT/CMD.pm533
-rw-r--r--lib/FLAT/CMD/AcyclicStrings.pm54
-rw-r--r--lib/FLAT/CMD/DFTStrings.pm55
-rw-r--r--lib/FLAT/DFA.pm557
-rw-r--r--lib/FLAT/FA.pm554
-rw-r--r--lib/FLAT/NFA.pm509
-rw-r--r--lib/FLAT/PFA.pm293
-rw-r--r--lib/FLAT/Regex.pm194
-rw-r--r--lib/FLAT/Regex/Op.pm282
-rw-r--r--lib/FLAT/Regex/Parser.pm82
-rw-r--r--lib/FLAT/Regex/Transform.pm18
-rw-r--r--lib/FLAT/Regex/Util.pm33
-rw-r--r--lib/FLAT/Regex/WithExtraOps.pm109
-rw-r--r--lib/FLAT/Symbol.pm98
-rw-r--r--lib/FLAT/Transition.pm66
-rw-r--r--lib/FLAT/XFA.pm3
-rw-r--r--lib/Kratos/DFADriver.pm1423
-rw-r--r--lib/Kratos/DFADriver/DFA.pm277
-rw-r--r--lib/Kratos/DFADriver/Model.pm495
-rw-r--r--lib/MIMOSA.pm177
-rw-r--r--lib/MIMOSA/Log.pm398
-rw-r--r--lib/Math/Cartesian/Product.pm262
26 files changed, 0 insertions, 7801 deletions
diff --git a/bin/merge.py b/bin/merge.py
deleted file mode 100755
index 551bc9e..0000000
--- a/bin/merge.py
+++ /dev/null
@@ -1,1053 +0,0 @@
-#!/usr/bin/env python3
-
-import getopt
-import json
-import numpy as np
-import os
-import re
-import sys
-import plotter
-from copy import deepcopy
-from dfatool import aggregate_measures, regression_measures, is_numeric, powerset
-from dfatool import append_if_set, mean_or_none, float_or_nan
-from matplotlib.patches import Polygon
-from scipy import optimize, stats
-#import pickle
-
-opts = {}
-
-def load_json(filename):
- with open(filename, "r") as f:
- return json.load(f)
-
-def save_json(data, filename):
- with open(filename, "w") as f:
- return json.dump(data, f)
-
-def print_data(aggregate):
- for key in sorted(aggregate.keys()):
- data = aggregate[key]
- name, params = key
- print("%s @ %s : ~ = %.f (%.f, %.f) µ_σ_outer = %.f n = %d" %
- (name, params, np.median(data['means']), np.percentile(data['means'], 25),
- np.percentile(data['means'], 75), np.mean(data['stds']), len(data['means'])))
-
-def flatten(somelist):
- return [item for sublist in somelist for item in sublist]
-
-def mimosa_data(elem):
- means = [x['uW_mean'] for x in elem['offline']]
- durations = [x['us'] - 20 for x in elem['offline']]
- stds = [x['uW_std'] for x in elem['offline']]
- energies = [x['uW_mean'] * (x['us'] - 20) for x in elem['offline']]
- clips = [x['clip_rate'] for x in elem['offline']]
- substate_thresholds = []
- substate_data = []
- timeouts = []
- rel_energies_prev = []
- rel_energies_next = []
- if 'timeout' in elem['offline'][0]:
- timeouts = [x['timeout'] for x in elem['offline']]
- if 'uW_mean_delta_prev' in elem['offline'][0]:
- rel_energies_prev = [x['uW_mean_delta_prev'] * (x['us'] - 20) for x in elem['offline']]
- if 'uW_mean_delta_next' in elem['offline'][0]:
- rel_energies_next = [x['uW_mean_delta_next'] * (x['us'] - 20) for x in elem['offline']]
- for x in elem['offline']:
- if 'substates' in x:
- substate_thresholds.append(x['substates']['threshold'])
- substate_data.append(x['substates']['states'])
-
- return (means, stds, durations, energies, rel_energies_prev,
- rel_energies_next, clips, timeouts, substate_thresholds)
-
-def online_data(elem):
- means = [int(x['power']) for x in elem['online']]
- durations = [int(x['time']) for x in elem['online']]
-
- return means, durations
-
-# parameters = statistic variables such as txpower, bitrate etc.
-# variables = function variables/parameters set by linear regression
-def str_to_param_function(function_string, parameters, variables):
- rawfunction = function_string
- dependson = [False] * len(parameters)
-
- for i in range(len(parameters)):
- if rawfunction.find("global(%s)" % (parameters[i])) >= 0:
- dependson[i] = True
- rawfunction = rawfunction.replace("global(%s)" % (parameters[i]), "arg[%d]" % (i))
- if rawfunction.find("local(%s)" % (parameters[i])) >= 0:
- dependson[i] = True
- rawfunction = rawfunction.replace("local(%s)" % (parameters[i]), "arg[%d]" % (i))
- for i in range(len(variables)):
- rawfunction = rawfunction.replace("param(%d)" % (i), "param[%d]" % (i))
- fitfunc = eval("lambda param, arg: " + rawfunction);
-
- return fitfunc, dependson
-
-def mk_function_data(name, paramdata, parameters, dependson, datatype):
- X = [[] for i in range(len(parameters))]
- Xm = [[] for i in range(len(parameters))]
- Y = []
- Ym = []
-
- num_valid = 0
- num_total = 0
-
- for key, val in paramdata.items():
- if key[0] == name and len(key[1]) == len(parameters):
- valid = True
- num_total += 1
- for i in range(len(parameters)):
- if dependson[i] and not is_numeric(key[1][i]):
- valid = False
- if valid:
- num_valid += 1
- Y.extend(val[datatype])
- Ym.append(np.median(val[datatype]))
- for i in range(len(parameters)):
- if dependson[i] or is_numeric(key[1][i]):
- X[i].extend([float(key[1][i])] * len(val[datatype]))
- Xm[i].append(float(key[1][i]))
- else:
- X[i].extend([0] * len(val[datatype]))
- Xm[i].append(0)
-
- for i in range(len(parameters)):
- X[i] = np.array(X[i])
- Xm[i] = np.array(Xm[i])
- X = tuple(X)
- Xm = tuple(Xm)
- Y = np.array(Y)
- Ym = np.array(Ym)
-
- return X, Y, Xm, Ym, num_valid, num_total
-
-def raw_num0_8(num):
- return (8 - num1(num))
-
-def raw_num0_16(num):
- return (16 - num1(num))
-
-def raw_num1(num):
- return bin(int(num)).count("1")
-
-num0_8 = np.vectorize(raw_num0_8)
-num0_16 = np.vectorize(raw_num0_16)
-num1 = np.vectorize(raw_num1)
-
-def try_fits(name, datatype, paramidx, paramdata):
- functions = {
- 'linear' : lambda param, arg: param[0] + param[1] * arg,
- 'logarithmic' : lambda param, arg: param[0] + param[1] * np.log(arg),
- 'logarithmic1' : lambda param, arg: param[0] + param[1] * np.log(arg + 1),
- 'exponential' : lambda param, arg: param[0] + param[1] * np.exp(arg),
- #'polynomial' : lambda param, arg: param[0] + param[1] * arg + param[2] * arg ** 2,
- 'square' : lambda param, arg: param[0] + param[1] * arg ** 2,
- 'fractional' : lambda param, arg: param[0] + param[1] / arg,
- 'sqrt' : lambda param, arg: param[0] + param[1] * np.sqrt(arg),
- 'num0_8' : lambda param, arg: param[0] + param[1] * num0_8(arg),
- 'num0_16' : lambda param, arg: param[0] + param[1] * num0_16(arg),
- 'num1' : lambda param, arg: param[0] + param[1] * num1(arg),
- }
- results = dict([[key, []] for key in functions.keys()])
- errors = {}
-
- allvalues = [(*key[1][:paramidx], *key[1][paramidx+1:]) for key in paramdata.keys() if key[0] == name]
- allvalues = list(set(allvalues))
-
- for value in allvalues:
- X = []
- Xm = []
- Y = []
- Ym = []
- num_valid = 0
- num_total = 0
- for key, val in paramdata.items():
- if key[0] == name and len(key[1]) > paramidx and (*key[1][:paramidx], *key[1][paramidx+1:]) == value:
- num_total += 1
- if is_numeric(key[1][paramidx]):
- num_valid += 1
- Y.extend(val[datatype])
- Ym.append(np.median(val[datatype]))
- X.extend([float(key[1][paramidx])] * len(val[datatype]))
- Xm.append(float(key[1][paramidx]))
- if float(key[1][paramidx]) == 0:
- functions.pop('fractional', None)
- if float(key[1][paramidx]) <= 0:
- functions.pop('logarithmic', None)
- if float(key[1][paramidx]) < 0:
- functions.pop('logarithmic1', None)
- functions.pop('sqrt', None)
- if float(key[1][paramidx]) > 64:
- functions.pop('exponential', None)
-
- # there should be -at least- two values when fitting
- if num_valid > 1:
- Y = np.array(Y)
- Ym = np.array(Ym)
- X = np.array(X)
- Xm = np.array(Xm)
- for kind, function in functions.items():
- results[kind] = {}
- errfunc = lambda P, X, y: function(P, X) - y
- try:
- res = optimize.least_squares(errfunc, [0, 1], args=(X, Y), xtol=2e-15)
- measures = regression_measures(function(res.x, X), Y)
- for k, v in measures.items():
- if not k in results[kind]:
- results[kind][k] = []
- results[kind][k].append(v)
- except:
- pass
-
- for function_name, result in results.items():
- if len(result) > 0 and function_name in functions:
- errors[function_name] = {}
- for measure in result.keys():
- errors[function_name][measure] = np.mean(result[measure])
-
- return errors
-
-def fit_function(function, name, datatype, parameters, paramdata, xaxis=None, yaxis=None):
-
- variables = list(map(lambda x: float(x), function['params']))
- fitfunc, dependson = str_to_param_function(function['raw'], parameters, variables)
-
- X, Y, Xm, Ym, num_valid, num_total = mk_function_data(name, paramdata, parameters, dependson, datatype)
-
- if num_valid > 0:
-
- if num_valid != num_total:
- num_invalid = num_total - num_valid
- print("Warning: fit(%s): %d of %d states had incomplete parameter hashes" % (name, num_invalid, len(paramdata)))
-
- errfunc = lambda P, X, y: fitfunc(P, X) - y
- try:
- res = optimize.least_squares(errfunc, variables, args=(X, Y), xtol=2e-15) # loss='cauchy'
- except ValueError as err:
- function['error'] = str(err)
- return
- #x1 = optimize.curve_fit(lambda param, *arg: fitfunc(param, arg), X, Y, functionparams)
- measures = regression_measures(fitfunc(res.x, X), Y)
-
- if res.status <= 0:
- function['error'] = res.message
- return
-
- if 'fit' in opts:
- for i in range(len(parameters)):
- plotter.plot_param_fit(function['raw'], name, fitfunc, res.x, parameters, datatype, i, X, Y, xaxis, yaxis)
-
- function['params'] = list(res.x)
- function['fit'] = measures
-
- else:
- function['error'] = 'log contained no numeric parameters'
-
-def assess_function(function, name, datatype, parameters, paramdata):
-
- variables = list(map(lambda x: float(x), function['params']))
- fitfunc, dependson = str_to_param_function(function['raw'], parameters, variables)
- X, Y, Xm, Ym, num_valid, num_total = mk_function_data(name, paramdata, parameters, dependson, datatype)
-
- if num_valid > 0:
- return regression_measures(fitfunc(variables, X), Y)
- else:
- return None
-
-def xv_assess_function(name, funbase, what, validation, mae, smape):
- goodness = assess_function(funbase, name, what, parameters, validation)
- if goodness != None:
- if not name in mae:
- mae[name] = []
- if not name in smape:
- smape[name] = []
- append_if_set(mae, goodness, 'mae')
- append_if_set(smape, goodness, 'smape')
-
-def xv2_assess_function(name, funbase, what, validation, mae, smape, rmsd):
- goodness = assess_function(funbase, name, what, parameters, validation)
- if goodness != None:
- if goodness['mae'] < 10e9:
- mae.append(goodness['mae'])
- rmsd.append(goodness['rmsd'])
- smape.append(goodness['smape'])
- else:
- print('[!] Ignoring MAE of %d (SMAPE %.f)' % (goodness['mae'], goodness['smape']))
-
-# Returns the values used for each parameter in the measurement, e.g.
-# { 'txpower' : [1, 2, 4, 8], 'length' : [16] }
-# non-numeric values such as '' are skipped
-def param_values(parameters, by_param):
- paramvalues = dict([[param, set()] for param in parameters])
-
- for _, paramvalue in by_param.keys():
- for i, param in enumerate(parameters):
- if is_numeric(paramvalue[i]):
- paramvalues[param].add(paramvalue[i])
-
- return paramvalues
-
-def param_hash(values):
- ret = {}
-
- for i, param in enumerate(parameters):
- ret[param] = values[i]
-
- return ret
-
-# Returns the values used for each function argument in the measurement, e.g.
-# { 'data': [], 'length' : [16, 31, 32] }
-# non-numeric values such as '' or 'long_test_string' are skipped
-def arg_values(name, by_arg):
- TODO
- argvalues = dict([[arg, set()] for arg in parameters])
-
- for _, paramvalue in by_param.keys():
- for i, param in enumerate(parameters):
- if is_numeric(paramvalue[i]):
- paramvalues[param].add(paramvalue[i])
-
- return paramvalues
-
-def mk_param_key(elem):
- name = elem['name']
- paramtuple = ()
-
- if 'parameter' in elem:
- paramkeys = sorted(elem['parameter'].keys())
- paramtuple = tuple([elem['parameter'][x] for x in paramkeys])
-
- return (name, paramtuple)
-
-def mk_arg_key(elem):
- name = elem['name']
- argtuple = ()
-
- if 'args' in elem:
- argtuple = tuple(elem['args'])
-
- return (name, argtuple)
-
-def add_data_to_aggregate(aggregate, key, isa, data):
- if not key in aggregate:
- aggregate[key] = {
- 'isa' : isa,
- }
- for datakey in data.keys():
- aggregate[key][datakey] = []
- for datakey, dataval in data.items():
- aggregate[key][datakey].extend(dataval)
-
-def fake_add_data_to_aggregate(aggregate, key, isa, database, idx):
- timeout_val = []
- if len(database['timeouts']):
- timeout_val = [database['timeouts'][idx]]
- rel_energy_p_val = []
- if len(database['rel_energies_prev']):
- rel_energy_p_val = [database['rel_energies_prev'][idx]]
- rel_energy_n_val = []
- if len(database['rel_energies_next']):
- rel_energy_n_val = [database['rel_energies_next'][idx]]
- add_data_to_aggregate(aggregate, key, isa, {
- 'means' : [database['means'][idx]],
- 'stds' : [database['stds'][idx]],
- 'durations' : [database['durations'][idx]],
- 'energies' : [database['energies'][idx]],
- 'rel_energies_prev' : rel_energy_p_val,
- 'rel_energies_next' : rel_energy_n_val,
- 'clip_rate' : [database['clip_rate'][idx]],
- 'timeouts' : timeout_val,
- })
-
-def weight_by_name(aggdata):
- total = {}
- count = {}
- weight = {}
- for key in aggdata.keys():
- if not key[0] in total:
- total[key[0]] = 0
- total[key[0]] += len(aggdata[key]['means'])
- count[key] = len(aggdata[key]['means'])
- for key in aggdata.keys():
- weight[key] = float(count[key]) / total[key[0]]
- return weight
-
-# returns the mean standard deviation of all measurements of 'what'
-# (e.g. power consumption or timeout) for state/transition 'name' where
-# parameter 'index' is dynamic and all other parameters are fixed.
-# I.e., if parameters are a, b, c ∈ {1,2,3} and 'index' corresponds to b', then
-# this function returns the mean of the standard deviations of (a=1, b=*, c=1),
-# (a=1, b=*, c=2), and so on
-def mean_std_by_param(data, keys, name, what, index):
- partitions = []
- for key in keys:
- partition = []
- for k, v in data.items():
- if (*k[1][:index], *k[1][index+1:]) == key and k[0] == name:
- partition.extend(v[what])
- partitions.append(partition)
- return np.mean([np.std(partition) for partition in partitions])
-
-def spearmanr_by_param(name, what, index):
- sr = stats.spearmanr(by_name[name][what], list(map(lambda x : float_or_nan(x[index]), by_name[name]['param'])))[0]
- if sr == np.nan:
- return None
- return sr
-
-# returns the mean standard deviation of all measurements of 'what'
-# (e.g. energy or duration) for transition 'name' where
-# the 'index'th argumetn is dynamic and all other arguments are fixed.
-# I.e., if arguments are a, b, c ∈ {1,2,3} and 'index' is 1, then
-# this function returns the mean of the standard deviations of (a=1, b=*, c=1),
-# (a=1, b=*, c=2), and so on
-def mean_std_by_arg(data, keys, name, what, index):
- return mean_std_by_param(data, keys, name, what, index)
-
-# returns the mean standard deviation of all measurements of 'what'
-# (e.g. power consumption or timeout) for state/transition 'name' where the
-# trace of previous transitions is fixed except for a single transition,
-# whose occurence or absence is silently ignored.
-# this is done separately for each transition (-> returns a dictionary)
-def mean_std_by_trace_part(data, transitions, name, what):
- ret = {}
- for transition in transitions:
- keys = set(map(lambda x : (x[0], x[1], tuple([y for y in x[2] if y != transition])), data.keys()))
- ret[transition] = {}
- partitions = []
- for key in keys:
- partition = []
- for k, v in data.items():
- key_without_transition = (k[0], k[1], tuple([y for y in k[2] if y != transition]))
- if key[0] == name and key == key_without_transition:
- partition.extend(v[what])
- if len(partition):
- partitions.append(partition)
- ret[transition] = np.mean([np.std(partition) for partition in partitions])
- return ret
-
-
-def load_run_elem(index, element, trace, by_name, by_arg, by_param, by_trace):
- means, stds, durations, energies, rel_energies_prev, rel_energies_next, clips, timeouts, sub_thresholds = mimosa_data(element)
-
- online_means = []
- online_durations = []
- if element['isa'] == 'state':
- online_means, online_durations = online_data(element)
-
- if 'voltage' in opts:
- element['parameter']['voltage'] = opts['voltage']
-
- arg_key = mk_arg_key(element)
- param_key = mk_param_key(element)
- pre_trace = tuple(map(lambda x : x['name'], trace[1:index:2]))
- trace_key = (*param_key, pre_trace)
- name = element['name']
-
- elem_data = {
- 'means' : means,
- 'stds' : stds,
- 'durations' : durations,
- 'energies' : energies,
- 'rel_energies_prev' : rel_energies_prev,
- 'rel_energies_next' : rel_energies_next,
- 'clip_rate' : clips,
- 'timeouts' : timeouts,
- 'sub_thresholds' : sub_thresholds,
- 'param' : [param_key[1]] * len(means),
- 'online_means' : online_means,
- 'online_durations' : online_durations,
- }
- add_data_to_aggregate(by_name, name, element['isa'], elem_data)
- add_data_to_aggregate(by_arg, arg_key, element['isa'], elem_data)
- add_data_to_aggregate(by_param, param_key, element['isa'], elem_data)
- add_data_to_aggregate(by_trace, trace_key, element['isa'], elem_data)
-
-def fmap(reftype, name, funtype):
- if funtype == 'linear':
- return "%s(%s)" % (reftype, name)
- if funtype == 'logarithmic':
- return "np.log(%s(%s))" % (reftype, name)
- if funtype == 'logarithmic1':
- return "np.log(%s(%s) + 1)" % (reftype, name)
- if funtype == 'exponential':
- return "np.exp(%s(%s))" % (reftype, name)
- if funtype == 'square':
- return "%s(%s)**2" % (reftype, name)
- if funtype == 'fractional':
- return "1 / %s(%s)" % (reftype, name)
- if funtype == 'sqrt':
- return "np.sqrt(%s(%s))" % (reftype, name)
- if funtype == 'num0_8':
- return "num0_8(%s(%s))" % (reftype, name)
- if funtype == 'num0_16':
- return "num0_16(%s(%s))" % (reftype, name)
- if funtype == 'num1':
- return "num1(%s(%s))" % (reftype, name)
- return "ERROR"
-
-def fguess_to_function(name, datatype, aggdata, parameters, paramdata, yaxis):
- best_fit = {}
- fitguess = aggdata['fit_guess']
- params = list(filter(lambda x : x in fitguess, parameters))
- if len(params) > 0:
- for param in params:
- best_fit_val = np.inf
- for func_name, fit_val in fitguess[param].items():
- if fit_val['rmsd'] < best_fit_val:
- best_fit_val = fit_val['rmsd']
- best_fit[param] = func_name
- buf = '0'
- pidx = 0
- for elem in powerset(best_fit.items()):
- buf += " + param(%d)" % pidx
- pidx += 1
- for fun in elem:
- buf += " * %s" % fmap('global', *fun)
- aggdata['function']['estimate'] = {
- 'raw' : buf,
- 'params' : list(np.ones((pidx))),
- 'base' : [best_fit[param] for param in params]
- }
- fit_function(
- aggdata['function']['estimate'], name, datatype, parameters,
- paramdata, yaxis=yaxis)
-
-def arg_fguess_to_function(name, datatype, aggdata, arguments, argdata, yaxis):
- best_fit = {}
- fitguess = aggdata['arg_fit_guess']
- args = list(filter(lambda x : x in fitguess, arguments))
- if len(args) > 0:
- for arg in args:
- best_fit_val = np.inf
- for func_name, fit_val in fitguess[arg].items():
- if fit_val['rmsd'] < best_fit_val:
- best_fit_val = fit_val['rmsd']
- best_fit[arg] = func_name
- buf = '0'
- pidx = 0
- for elem in powerset(best_fit.items()):
- buf += " + param(%d)" % pidx
- pidx += 1
- for fun in elem:
- buf += " * %s" % fmap('local', *fun)
- aggdata['function']['estimate_arg'] = {
- 'raw' : buf,
- 'params' : list(np.ones((pidx))),
- 'base' : [best_fit[arg] for arg in args]
- }
- fit_function(
- aggdata['function']['estimate_arg'], name, datatype, arguments,
- argdata, yaxis=yaxis)
-
-def param_measures(name, paramdata, key, fun):
- mae = []
- smape = []
- rmsd = []
- for pkey, pval in paramdata.items():
- if pkey[0] == name:
- # Median ist besseres Maß für MAE / SMAPE,
- # Mean ist besseres für SSR. Da least_squares SSR optimiert
- # nutzen wir hier auch Mean.
- goodness = aggregate_measures(fun(pval[key]), pval[key])
- append_if_set(mae, goodness, 'mae')
- append_if_set(rmsd, goodness, 'rmsd')
- append_if_set(smape, goodness, 'smape')
- ret = {
- 'mae' : mean_or_none(mae),
- 'rmsd' : mean_or_none(rmsd),
- 'smape' : mean_or_none(smape)
- }
-
- return ret
-
-def arg_measures(name, argdata, key, fun):
- return param_measures(name, argdata, key, fun)
-
-def lookup_table(name, paramdata, key, fun, keyfun):
- lut = []
-
- for pkey, pval in paramdata.items():
- if pkey[0] == name:
- lut.append({
- 'key': keyfun(pkey[1]),
- 'value': fun(pval[key]),
- })
-
- return lut
-
-def keydata(name, val, argdata, paramdata, tracedata, key):
- ret = {
- 'count' : len(val[key]),
- 'median' : np.median(val[key]),
- 'mean' : np.mean(val[key]),
- 'median_by_param' : lookup_table(name, paramdata, key, np.median, param_hash),
- 'mean_goodness' : aggregate_measures(np.mean(val[key]), val[key]),
- 'median_goodness' : aggregate_measures(np.median(val[key]), val[key]),
- 'param_mean_goodness' : param_measures(name, paramdata, key, np.mean),
- 'param_median_goodness' : param_measures(name, paramdata, key, np.median),
- 'std_inner' : np.std(val[key]),
- 'std_param' : np.mean([np.std(paramdata[x][key]) for x in paramdata.keys() if x[0] == name]),
- 'std_trace' : np.mean([np.std(tracedata[x][key]) for x in tracedata.keys() if x[0] == name]),
- 'std_by_param' : {},
- 'spearmanr_by_param' : {},
- 'fit_guess' : {},
- 'function' : {},
- }
-
- if val['isa'] == 'transition':
- ret['arg_mean_goodness'] = arg_measures(name, argdata, key, np.mean)
- ret['arg_median_goodness'] = arg_measures(name, argdata, key, np.median)
- ret['median_by_arg'] = lookup_table(name, argdata, key, np.median, list)
- ret['std_arg'] = np.mean([np.std(argdata[x][key]) for x in argdata.keys() if x[0] == name])
- ret['std_by_arg'] = {}
- ret['arg_fit_guess'] = {}
-
- return ret
-
-def splitidx_kfold(length, num_slices):
- pairs = []
- indexes = np.arange(length)
- for i in range(0, num_slices):
- training = np.delete(indexes, slice(i, None, num_slices))
- validation = indexes[i::num_slices]
- pairs.append((training, validation))
- return pairs
-
-def splitidx_srs(length, num_slices):
- pairs = []
- for i in range(0, num_slices):
- shuffled = np.random.permutation(np.arange(length))
- border = int(length * float(2) / 3)
- training = shuffled[:border]
- validation = shuffled[border:]
- pairs.append((training, validation))
- return pairs
-
-def val_run(aggdata, split_fun, count):
- mae = []
- smape = []
- rmsd = []
- pairs = split_fun(len(aggdata), count)
- for i in range(0, count):
- training = aggdata[pairs[i][0]]
- validation = aggdata[pairs[i][1]]
- median = np.median(training)
- goodness = aggregate_measures(median, validation)
- append_if_set(mae, goodness, 'mae')
- append_if_set(rmsd, goodness, 'rmsd')
- append_if_set(smape, goodness, 'smape')
-
- mae_mean = np.mean(mae)
- rmsd_mean = np.mean(rmsd)
- if len(smape):
- smape_mean = np.mean(smape)
- else:
- smape_mean = -1
-
- return mae_mean, smape_mean, rmsd_mean
-
-# by_trace is not part of the cross-validation process
-def val_run_fun(aggdata, by_trace, name, key, funtype1, funtype2, splitfun, count):
- aggdata = aggdata[name]
- isa = aggdata['isa']
- mae = []
- smape = []
- rmsd = []
- estimates = []
- pairs = splitfun(len(aggdata[key]), count)
- for i in range(0, count):
- bpa_training = {}
- bpa_validation = {}
-
- for idx in pairs[i][0]:
- bpa_key = (name, aggdata['param'][idx])
- fake_add_data_to_aggregate(bpa_training, bpa_key, isa, aggdata, idx)
- for idx in pairs[i][1]:
- bpa_key = (name, aggdata['param'][idx])
- fake_add_data_to_aggregate(bpa_validation, bpa_key, isa, aggdata, idx)
-
- fake_by_name = { name : aggdata }
- ares = analyze(fake_by_name, {}, bpa_training, by_trace, parameters)
- if name in ares[isa] and funtype2 in ares[isa][name][funtype1]['function']:
- xv2_assess_function(name, ares[isa][name][funtype1]['function'][funtype2], key, bpa_validation, mae, smape, rmsd)
- if funtype2 == 'estimate':
- if 'base' in ares[isa][name][funtype1]['function'][funtype2]:
- estimates.append(tuple(ares[isa][name][funtype1]['function'][funtype2]['base']))
- else:
- estimates.append(None)
- return mae, smape, rmsd, estimates
-
-# by_trace is not part of the cross-validation process
-def val_run_fun_p(aggdata, by_trace, name, key, funtype1, funtype2, splitfun, count):
- aggdata = dict([[x, aggdata[x]] for x in aggdata if x[0] == name])
- isa = aggdata[list(aggdata.keys())[0]]['isa']
- mae = []
- smape = []
- rmsd = []
- estimates = []
- pairs = splitfun(len(aggdata.keys()), count) # pairs are by_param index arrays
- keys = sorted(aggdata.keys())
- for i in range(0, count):
- bpa_training = dict([[keys[x], aggdata[keys[x]]] for x in pairs[i][0]])
- bpa_validation = dict([[keys[x], aggdata[keys[x]]] for x in pairs[i][1]])
- bna_training = {}
- for val in bpa_training.values():
- for idx in range(0, len(val[key])):
- fake_add_data_to_aggregate(bna_training, name, isa, val, idx)
-
- ares = analyze(bna_training, {}, bpa_training, by_trace, parameters)
- if name in ares[isa] and funtype2 in ares[isa][name][funtype1]['function']:
- xv2_assess_function(name, ares[isa][name][funtype1]['function'][funtype2], key, bpa_validation, mae, smape, rmsd)
- if funtype2 == 'estimate':
- if 'base' in ares[isa][name][funtype1]['function'][funtype2]:
- estimates.append(tuple(ares[isa][name][funtype1]['function'][funtype2]['base']))
- else:
- estimates.append(None)
- return mae, smape, rmsd, estimates
-
-def crossvalidate(by_name, by_param, by_trace, model, parameters):
- param_mc_count = 200
- paramv = param_values(parameters, by_param)
- for name in sorted(by_name.keys()):
- isa = by_name[name]['isa']
- by_name[name]['means'] = np.array(by_name[name]['means'])
- by_name[name]['energies'] = np.array(by_name[name]['energies'])
- by_name[name]['rel_energies_prev'] = np.array(by_name[name]['rel_energies_prev'])
- by_name[name]['rel_energies_next'] = np.array(by_name[name]['rel_energies_next'])
- by_name[name]['durations'] = np.array(by_name[name]['durations'])
-
- if isa == 'state':
- mae_mean, smape_mean, rms_mean = val_run(by_name[name]['means'], splitidx_srs, 200)
- print('%16s, static power, Monte Carlo: MAE %8.f µW, SMAPE %6.2f%%, RMS %d' % (name, mae_mean, smape_mean, rms_mean))
- mae_mean, smape_mean, rms_mean = val_run(by_name[name]['means'], splitidx_kfold, 10)
- print('%16s, static power, 10-fold sys: MAE %8.f µW, SMAPE %6.2f%%, RMS %d' % (name, mae_mean, smape_mean, rms_mean))
- else:
- mae_mean, smape_mean, rms_mean = val_run(by_name[name]['energies'], splitidx_srs, 200)
- print('%16s, static energy, Monte Carlo: MAE %8.f pJ, SMAPE %6.2f%%, RMS %d' % (name, mae_mean, smape_mean, rms_mean))
- mae_mean, smape_mean, rms_mean = val_run(by_name[name]['energies'], splitidx_kfold, 10)
- print('%16s, static energy, 10-fold sys: MAE %8.f pJ, SMAPE %6.2f%%, RMS %d' % (name, mae_mean, smape_mean, rms_mean))
- mae_mean, smape_mean, rms_mean = val_run(by_name[name]['rel_energies_prev'], splitidx_srs, 200)
- print('%16s, static rel_energy_p, Monte Carlo: MAE %8.f pJ, SMAPE %6.2f%%, RMS %d' % (name, mae_mean, smape_mean, rms_mean))
- mae_mean, smape_mean, rms_mean = val_run(by_name[name]['rel_energies_prev'], splitidx_kfold, 10)
- print('%16s, static rel_energy_p, 10-fold sys: MAE %8.f pJ, SMAPE %6.2f%%, RMS %d' % (name, mae_mean, smape_mean, rms_mean))
- mae_mean, smape_mean, rms_mean = val_run(by_name[name]['rel_energies_next'], splitidx_srs, 200)
- print('%16s, static rel_energy_n, Monte Carlo: MAE %8.f pJ, SMAPE %6.2f%%, RMS %d' % (name, mae_mean, smape_mean, rms_mean))
- mae_mean, smape_mean, rms_mean = val_run(by_name[name]['rel_energies_next'], splitidx_kfold, 10)
- print('%16s, static rel_energy_n, 10-fold sys: MAE %8.f pJ, SMAPE %6.2f%%, RMS %d' % (name, mae_mean, smape_mean, rms_mean))
- mae_mean, smape_mean, rms_mean = val_run(by_name[name]['durations'], splitidx_srs, 200)
- print('%16s, static duration, Monte Carlo: MAE %8.f µs, SMAPE %6.2f%%, RMS %d' % (name, mae_mean, smape_mean, rms_mean))
- mae_mean, smape_mean, rms_mean = val_run(by_name[name]['durations'], splitidx_kfold, 10)
- print('%16s, static duration, 10-fold sys: MAE %8.f µs, SMAPE %6.2f%%, RMS %d' % (name, mae_mean, smape_mean, rms_mean))
-
- def print_estimates(estimates, total):
- histogram = {}
- buf = ' '
- for estimate in estimates:
- if not estimate in histogram:
- histogram[estimate] = 1
- else:
- histogram[estimate] += 1
- for estimate, count in sorted(histogram.items(), key=lambda kv: kv[1], reverse=True):
- buf += ' %.f%% %s' % (count * 100 / total, estimate)
- if len(estimates):
- print(buf)
-
- def val_run_funs(by_name, by_trace, name, key1, key2, key3, unit):
- mae, smape, rmsd, estimates = val_run_fun(by_name, by_trace, name, key1, key2, key3, splitidx_srs, param_mc_count)
- print('%16s, %8s %12s, Monte Carlo: MAE %8.f %s, SMAPE %6.2f%%, RMS %d' % (
- name, key3, key2, np.mean(mae), unit, np.mean(smape), np.mean(rmsd)))
- print_estimates(estimates, param_mc_count)
- mae, smape, rmsd, estimates = val_run_fun(by_name, by_trace, name, key1, key2, key3, splitidx_kfold, 10)
- print('%16s, %8s %12s, 10-fold sys: MAE %8.f %s, SMAPE %6.2f%%, RMS %d' % (
- name, key3, key2, np.mean(mae), unit, np.mean(smape), np.mean(rmsd)))
- print_estimates(estimates, 10)
- mae, smape, rmsd, estimates = val_run_fun_p(by_param, by_trace, name, key1, key2, key3, splitidx_srs, param_mc_count)
- print('%16s, %8s %12s, param-aware Monte Carlo: MAE %8.f %s, SMAPE %6.2f%%, RMS %d' % (
- name, key3, key2, np.mean(mae), unit, np.mean(smape), np.mean(rmsd)))
- print_estimates(estimates, param_mc_count)
- mae, smape, rmsd, estimates = val_run_fun_p(by_param, by_trace, name, key1, key2, key3, splitidx_kfold, 10)
- print('%16s, %8s %12s, param-aware 10-fold sys: MAE %8.f %s, SMAPE %6.2f%%, RMS %d' % (
- name, key3, key2, np.mean(mae), unit, np.mean(smape), np.mean(rmsd)))
- print_estimates(estimates, 10)
-
- if 'power' in model[isa][name] and 'function' in model[isa][name]['power']:
- if 'user' in model[isa][name]['power']['function']:
- val_run_funs(by_name, by_trace, name, 'means', 'power', 'user', 'µW')
- if 'estimate' in model[isa][name]['power']['function']:
- val_run_funs(by_name, by_trace, name, 'means', 'power', 'estimate', 'µW')
- if 'timeout' in model[isa][name] and 'function' in model[isa][name]['timeout']:
- if 'user' in model[isa][name]['timeout']['function']:
- val_run_funs(by_name, by_trace, name, 'timeouts', 'timeout', 'user', 'µs')
- if 'estimate' in model[isa][name]['timeout']['function']:
- val_run_funs(by_name, by_trace, name, 'timeouts', 'timeout', 'estimate', 'µs')
- if 'duration' in model[isa][name] and 'function' in model[isa][name]['duration']:
- if 'user' in model[isa][name]['duration']['function']:
- val_run_funs(by_name, by_trace, name, 'durations', 'duration', 'user', 'µs')
- if 'estimate' in model[isa][name]['duration']['function']:
- val_run_funs(by_name, by_trace, name, 'durations', 'duration', 'estimate', 'µs')
- if 'energy' in model[isa][name] and 'function' in model[isa][name]['energy']:
- if 'user' in model[isa][name]['energy']['function']:
- val_run_funs(by_name, by_trace, name, 'energies', 'energy', 'user', 'pJ')
- if 'estimate' in model[isa][name]['energy']['function']:
- val_run_funs(by_name, by_trace, name, 'energies', 'energy', 'estimate', 'pJ')
- if 'rel_energy_prev' in model[isa][name] and 'function' in model[isa][name]['rel_energy_prev']:
- if 'user' in model[isa][name]['rel_energy_prev']['function']:
- val_run_funs(by_name, by_trace, name, 'rel_energies_prev', 'rel_energy_prev', 'user', 'pJ')
- if 'estimate' in model[isa][name]['rel_energy_prev']['function']:
- val_run_funs(by_name, by_trace, name, 'rel_energies_prev', 'rel_energy_prev', 'estimate', 'pJ')
- if 'rel_energy_next' in model[isa][name] and 'function' in model[isa][name]['rel_energy_next']:
- if 'user' in model[isa][name]['rel_energy_next']['function']:
- val_run_funs(by_name, by_trace, name, 'rel_energies_next', 'rel_energy_next', 'user', 'pJ')
- if 'estimate' in model[isa][name]['rel_energy_next']['function']:
- val_run_funs(by_name, by_trace, name, 'rel_energies_next', 'rel_energy_next', 'estimate', 'pJ')
-
- return
- for i, param in enumerate(parameters):
- user_mae = {}
- user_smape = {}
- estimate_mae = {}
- estimate_smape = {}
- for val in paramv[param]:
- bpa_training = dict([[x, by_param[x]] for x in by_param if x[1][i] != val])
- bpa_validation = dict([[x, by_param[x]] for x in by_param if x[1][i] == val])
- to_pop = []
- for name in by_name.keys():
- if not any(map(lambda x : x[0] == name, bpa_training.keys())):
- to_pop.append(name)
- for name in to_pop:
- by_name.pop(name, None)
- ares = analyze(by_name, {}, bpa_training, by_trace, parameters)
- for name in sorted(ares['state'].keys()):
- state = ares['state'][name]
- if 'function' in state['power']:
- if 'user' in state['power']['function']:
- xv_assess_function(name, state['power']['function']['user'], 'means', bpa_validation, user_mae, user_smape)
- if 'estimate' in state['power']['function']:
- xv_assess_function(name, state['power']['function']['estimate'], 'means', bpa_validation, estimate_mae, estimate_smape)
- for name in sorted(ares['transition'].keys()):
- trans = ares['transition'][name]
- if 'timeout' in trans and 'function' in trans['timeout']:
- if 'user' in trans['timeout']['function']:
- xv_assess_function(name, trans['timeout']['function']['user'], 'timeouts', bpa_validation, user_mae, user_smape)
- if 'estimate' in trans['timeout']['function']:
- xv_assess_function(name, trans['timeout']['function']['estimate'], 'timeouts', bpa_validation, estimate_mae, estimate_smape)
-
- for name in sorted(user_mae.keys()):
- if by_name[name]['isa'] == 'state':
- print('user function %s power by %s: MAE %.f µW, SMAPE %.2f%%' % (
- name, param, np.mean(user_mae[name]), np.mean(user_smape[name])))
- else:
- print('user function %s timeout by %s: MAE %.f µs, SMAPE %.2f%%' % (
- name, param, np.mean(user_mae[name]), np.mean(user_smape[name])))
- for name in sorted(estimate_mae.keys()):
- if by_name[name]['isa'] == 'state':
- print('estimate function %s power by %s: MAE %.f µW, SMAPE %.2f%%' % (
- name, param, np.mean(estimate_mae[name]), np.mean(estimate_smape[name])))
- else:
- print('estimate function %s timeout by %s: MAE %.f µs, SMAPE %.2f%%' % (
- name, param, np.mean(estimate_mae[name]), np.mean(estimate_smape[name])))
-
-def analyze_by_param(aggval, by_param, allvalues, name, key1, key2, param, param_idx):
- aggval[key1]['std_by_param'][param] = mean_std_by_param(
- by_param, allvalues, name, key2, param_idx)
- aggval[key1]['spearmanr_by_param'][param] = spearmanr_by_param(name, key2, param_idx)
- if aggval[key1]['std_by_param'][param] > 0 and aggval[key1]['std_param'] / aggval[key1]['std_by_param'][param] < 0.6:
- aggval[key1]['fit_guess'][param] = try_fits(name, key2, param_idx, by_param)
-
-def analyze_by_arg(aggval, by_arg, allvalues, name, key1, key2, arg_name, arg_idx):
- aggval[key1]['std_by_arg'][arg_name] = mean_std_by_arg(
- by_arg, allvalues, name, key2, arg_idx)
- if aggval[key1]['std_by_arg'][arg_name] > 0 and aggval[key1]['std_arg'] / aggval[key1]['std_by_arg'][arg_name] < 0.6:
- aggval[key1]['arg_fit_guess'][arg_name] = try_fits(name, key2, arg_idx, by_arg)
-
-def maybe_fit_function(aggval, model, by_param, parameters, name, key1, key2, unit):
- if 'function' in model[key1] and 'user' in model[key1]['function']:
- aggval[key1]['function']['user'] = {
- 'raw' : model[key1]['function']['user']['raw'],
- 'params' : model[key1]['function']['user']['params'],
- }
- fit_function(
- aggval[key1]['function']['user'], name, key2, parameters, by_param,
- yaxis='%s %s by param [%s]' % (name, key1, unit))
-
-def analyze(by_name, by_arg, by_param, by_trace, parameters):
- aggdata = {
- 'state' : {},
- 'transition' : {},
- 'min_voltage' : min_voltage,
- 'max_voltage' : max_voltage,
- }
- transition_names = list(map(lambda x: x[0], filter(lambda x: x[1]['isa'] == 'transition', by_name.items())))
- for name, val in by_name.items():
- isa = val['isa']
- model = data['model'][isa][name]
-
- aggdata[isa][name] = {
- 'power' : keydata(name, val, by_arg, by_param, by_trace, 'means'),
- 'duration' : keydata(name, val, by_arg, by_param, by_trace, 'durations'),
- 'energy' : keydata(name, val, by_arg, by_param, by_trace, 'energies'),
- 'clip' : {
- 'mean' : np.mean(val['clip_rate']),
- 'max' : max(val['clip_rate']),
- },
- 'timeout' : {},
- }
-
- aggval = aggdata[isa][name]
- aggval['power']['std_outer'] = np.mean(val['stds'])
-
- if isa == 'transition':
- aggval['rel_energy_prev'] = keydata(name, val, by_arg, by_param, by_trace, 'rel_energies_prev')
- aggval['rel_energy_next'] = keydata(name, val, by_arg, by_param, by_trace, 'rel_energies_next')
- aggval['timeout'] = keydata(name, val, by_arg, by_param, by_trace, 'timeouts')
-
- for i, param in enumerate(parameters):
- values = list(set([key[1][i] for key in by_param.keys() if key[0] == name and key[1][i] != '']))
- allvalues = [(*key[1][:i], *key[1][i+1:]) for key in by_param.keys() if key[0] == name]
- #allvalues = list(set(allvalues))
- if len(values) > 1:
- if isa == 'state':
- analyze_by_param(aggval, by_param, allvalues, name, 'power', 'means', param, i)
- else:
- analyze_by_param(aggval, by_param, allvalues, name, 'duration', 'durations', param, i)
- analyze_by_param(aggval, by_param, allvalues, name, 'energy', 'energies', param, i)
- analyze_by_param(aggval, by_param, allvalues, name, 'rel_energy_prev', 'rel_energies_prev', param, i)
- analyze_by_param(aggval, by_param, allvalues, name, 'rel_energy_next', 'rel_energies_next', param, i)
- analyze_by_param(aggval, by_param, allvalues, name, 'timeout', 'timeouts', param, i)
-
- if isa == 'state':
- fguess_to_function(name, 'means', aggval['power'], parameters, by_param,
- 'estimated %s power by param [µW]' % name)
- maybe_fit_function(aggval, model, by_param, parameters, name, 'power', 'means', 'µW')
- if aggval['power']['std_param'] > 0 and aggval['power']['std_trace'] / aggval['power']['std_param'] < 0.5:
- aggval['power']['std_by_trace'] = mean_std_by_trace_part(by_trace, transition_names, name, 'means')
- else:
- fguess_to_function(name, 'durations', aggval['duration'], parameters, by_param,
- 'estimated %s duration by param [µs]' % name)
- fguess_to_function(name, 'energies', aggval['energy'], parameters, by_param,
- 'estimated %s energy by param [pJ]' % name)
- fguess_to_function(name, 'rel_energies_prev', aggval['rel_energy_prev'], parameters, by_param,
- 'estimated relative_prev %s energy by param [pJ]' % name)
- fguess_to_function(name, 'rel_energies_next', aggval['rel_energy_next'], parameters, by_param,
- 'estimated relative_next %s energy by param [pJ]' % name)
- fguess_to_function(name, 'timeouts', aggval['timeout'], parameters, by_param,
- 'estimated %s timeout by param [µs]' % name)
- maybe_fit_function(aggval, model, by_param, parameters, name, 'duration', 'durations', 'µs')
- maybe_fit_function(aggval, model, by_param, parameters, name, 'energy', 'energies', 'pJ')
- maybe_fit_function(aggval, model, by_param, parameters, name, 'rel_energy_prev', 'rel_energies_prev', 'pJ')
- maybe_fit_function(aggval, model, by_param, parameters, name, 'rel_energy_next', 'rel_energies_next', 'pJ')
- maybe_fit_function(aggval, model, by_param, parameters, name, 'timeout', 'timeouts', 'µs')
-
- for i, arg in enumerate(model['parameters']):
- values = list(set([key[1][i] for key in by_arg.keys() if key[0] == name and is_numeric(key[1][i])]))
- allvalues = [(*key[1][:i], *key[1][i+1:]) for key in by_arg.keys() if key[0] == name]
- analyze_by_arg(aggval, by_arg, allvalues, name, 'duration', 'durations', arg['name'], i)
- analyze_by_arg(aggval, by_arg, allvalues, name, 'energy', 'energies', arg['name'], i)
- analyze_by_arg(aggval, by_arg, allvalues, name, 'rel_energy_prev', 'rel_energies_prev', arg['name'], i)
- analyze_by_arg(aggval, by_arg, allvalues, name, 'rel_energy_next', 'rel_energies_next', arg['name'], i)
- analyze_by_arg(aggval, by_arg, allvalues, name, 'timeout', 'timeouts', arg['name'], i)
-
- arguments = list(map(lambda x: x['name'], model['parameters']))
- arg_fguess_to_function(name, 'durations', aggval['duration'], arguments, by_arg,
- 'estimated %s duration by arg [µs]' % name)
- arg_fguess_to_function(name, 'energies', aggval['energy'], arguments, by_arg,
- 'estimated %s energy by arg [pJ]' % name)
- arg_fguess_to_function(name, 'rel_energies_prev', aggval['rel_energy_prev'], arguments, by_arg,
- 'estimated relative_prev %s energy by arg [pJ]' % name)
- arg_fguess_to_function(name, 'rel_energies_next', aggval['rel_energy_next'], arguments, by_arg,
- 'estimated relative_next %s energy by arg [pJ]' % name)
- arg_fguess_to_function(name, 'timeouts', aggval['timeout'], arguments, by_arg,
- 'estimated %s timeout by arg [µs]' % name)
-
- return aggdata
-
-try:
- raw_opts, args = getopt.getopt(sys.argv[1:], "", [
- "fit", "states", "transitions", "params", "clipping", "timing",
- "histogram", "substates", "validate", "crossvalidate", "ignore-trace-idx=", "voltage"])
- for option, parameter in raw_opts:
- optname = re.sub(r'^--', '', option)
- opts[optname] = parameter
- if 'ignore-trace-idx' in opts:
- opts['ignore-trace-idx'] = int(opts['ignore-trace-idx'])
-except getopt.GetoptError as err:
- print(err)
- sys.exit(2)
-
-data = load_json(args[0])
-by_name = {}
-by_arg = {}
-by_param = {}
-by_trace = {}
-
-if 'voltage' in opts:
- data['model']['parameter']['voltage'] = {
- 'default' : float(data['setup']['mimosa_voltage']),
- 'function' : None,
- 'arg_name' : None,
- }
-
-min_voltage = float(data['setup']['mimosa_voltage'])
-max_voltage = float(data['setup']['mimosa_voltage'])
-
-parameters = sorted(data['model']['parameter'].keys())
-
-for arg in args:
- mdata = load_json(arg)
- this_voltage = float(mdata['setup']['mimosa_voltage'])
- if this_voltage > max_voltage:
- max_voltage = this_voltage
- if this_voltage < min_voltage:
- min_voltage = this_voltage
- if 'voltage' in opts:
- opts['voltage'] = this_voltage
- for runidx, run in enumerate(mdata['traces']):
- if 'ignore-trace-idx' not in opts or opts['ignore-trace-idx'] != runidx:
- for i, elem in enumerate(run['trace']):
- if elem['name'] != 'UNINITIALIZED':
- load_run_elem(i, elem, run['trace'], by_name, by_arg, by_param, by_trace)
-
-#with open('/tmp/by_name.pickle', 'wb') as f:
-# pickle.dump(by_name, f, pickle.HIGHEST_PROTOCOL)
-#with open('/tmp/by_arg.pickle', 'wb') as f:
-# pickle.dump(by_arg, f, pickle.HIGHEST_PROTOCOL)
-#with open('/tmp/by_param.pickle', 'wb') as f:
-# pickle.dump(by_param, f, pickle.HIGHEST_PROTOCOL)
-
-if 'states' in opts:
- if 'params' in opts:
- plotter.plot_states_param(data['model'], by_param)
- else:
- plotter.plot_states(data['model'], by_name)
- if 'timing' in opts:
- plotter.plot_states_duration(data['model'], by_name)
- plotter.plot_states_duration(data['model'], by_param)
- if 'clipping' in opts:
- plotter.plot_states_clips(data['model'], by_name)
-if 'transitions' in opts:
- plotter.plot_transitions(data['model'], by_name)
- if 'timing' in opts:
- plotter.plot_transitions_duration(data['model'], by_name)
- plotter.plot_transitions_timeout(data['model'], by_param)
- if 'clipping' in opts:
- plotter.plot_transitions_clips(data['model'], by_name)
-if 'histogram' in opts:
- for key in sorted(by_name.keys()):
- plotter.plot_histogram(by_name[key]['means'])
-if 'substates' in opts:
- if 'params' in opts:
- plotter.plot_substate_thresholds_p(data['model'], by_param)
- else:
- plotter.plot_substate_thresholds(data['model'], by_name)
-
-if 'crossvalidate' in opts:
- crossvalidate(by_name, by_param, by_trace, data['model'], parameters)
-else:
- data['aggregate'] = analyze(by_name, by_arg, by_param, by_trace, parameters)
-
-# TODO optionally also plot data points for states/transitions which do not have
-# a function, but may depend on a parameter (visualization is always good!)
-
-save_json(data, args[0])
diff --git a/bin/mimosawatch b/bin/mimosawatch
deleted file mode 100755
index 88d34a3..0000000
--- a/bin/mimosawatch
+++ /dev/null
@@ -1,24 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-use 5.020;
-
-use File::Slurp qw(slurp);
-use IO::Handle;
-
-our $VERSION = '0.00';
-
-STDOUT->autoflush(1);
-
-while (sleep(1)) {
- if ( -e '/tmp/mimosa/mimosa_scale_100000.tmp' ) {
- my $raw_data = slurp('/tmp/mimosa/mimosa_scale_100000.tmp');
- my @data = map { $_ >> 8 } unpack('L*', $raw_data);
- my @buzzer = map { $_ & 0x0f } unpack('L*', $raw_data);
-
- if (@data > 8) {
- printf("\r\e[2K" . ('%8d ' x 8), @data[-8 .. -1]);
- }
- }
-}
diff --git a/lib/AspectC/Repo/Function.pm b/lib/AspectC/Repo/Function.pm
deleted file mode 100644
index a7edae2..0000000
--- a/lib/AspectC/Repo/Function.pm
+++ /dev/null
@@ -1,55 +0,0 @@
-package AspectC::Repo::Function;
-
-use strict;
-use warnings;
-use 5.020;
-
-our $VERSION = '0.00';
-
-sub new {
- my ( $class, %opts ) = @_;
-
- my $self = {};
-
- return bless( $self, $class );
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-=head1 SYNOPSIS
-
-=head1 VERSION
-
-version
-
-=head1 DESCRIPTION
-
-=head1 METHODS
-
-=over
-
-=back
-
-=head1 DIAGNOSTICS
-
-=head1 DEPENDENCIES
-
-=over
-
-=back
-
-=head1 BUGS AND LIMITATIONS
-
-=head1 SEE ALSO
-
-=head1 AUTHOR
-
-Copyright (C) 2016 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>
-
-=head1 LICENSE
-
- 0. You just DO WHAT THE FUCK YOU WANT TO.
diff --git a/lib/FLAT.pm b/lib/FLAT.pm
deleted file mode 100644
index ee6af9d..0000000
--- a/lib/FLAT.pm
+++ /dev/null
@@ -1,197 +0,0 @@
-package FLAT;
-use FLAT::Regex;
-use FLAT::NFA;
-use FLAT::DFA;
-use Carp;
-
-use vars '$VERSION';
-$VERSION = 0.9.1;
-
-=head1 NAME
-
-FLAT - Formal Language & Automata Toolkit
-
-=head1 SYNOPSIS
-
-FLAT.pm is the base class of all regular language objects. For more
-information, see other POD pages.
-
-=head1 USAGE
-
-All regular language objects in FLAT implement the following methods.
-Specific regular language representations (regex, NFA, DFA) may implement
-additional methods that are outlined in the repsective POD pages.
-
-=cut
-
-## let subclasses implement a minimal set of closure properties.
-## they can override these with more efficient versions if they like.
-
-sub as_dfa {
- $_[0]->as_nfa->as_dfa;
-}
-
-sub as_min_dfa {
- $_[0]->as_dfa->as_min_dfa;
-}
-
-sub is_infinite {
- ! $_[0]->is_finite;
-}
-
-sub star {
- $_[0]->kleene
-}
-
-sub difference {
- $_[0]->intersect( $_[1]->complement );
-}
-
-sub symdiff {
- my $self = shift;
- return $self if not @_;
- my $next = shift()->symdiff(@_);
- ( $self->difference($next) )->union( $next->difference($self) );
-}
-
-sub equals {
- $_[0]->symdiff($_[1])->is_empty
-}
-
-sub is_subset_of {
- $_[0]->difference($_[1])->is_empty
-}
-
-BEGIN {
- for my $method (qw[ as_nfa as_regex union intersect complement concat
- kleene reverse is_empty is_finite ])
- {
- no strict 'refs';
- *$method = sub {
- my $pkg = ref $_[0] || $_[0];
- carp "$pkg does not (yet) implement $method";
- };
- }
-}
-
-1;
-
-__END__
-
-=head2 Conversions Among Representations
-
-=over
-
-=item $lang-E<gt>as_nfa
-
-=item $lang-E<gt>as_dfa
-
-=item $lang-E<gt>as_min_dfa
-
-=item $lang-E<gt>as_regex
-
-Returns an equivalent regular language to $lang in the desired
-representation. Does not modify $lang (even if $lang is already in the
-desired representation).
-
-For more information on the specific algorithms used in these conversions,
-see the POD pages for a specific representation.
-
-=back
-
-=head2 Closure Properties
-
-=over
-
-=item $lang1-E<gt>union($lang2, $lang3, ... )
-
-=item $lang1-E<gt>intersect($lang2, $lang3, ... )
-
-=item $lang1-E<gt>concat($lang2, $lang3, ... )
-
-=item $lang1-E<gt>symdiff($lang2, $lang3, ... )
-
-Returns a regular language object that is the union, intersection,
-concatenation, or symmetric difference of $lang1 ... $langN, respectively.
-The return value will have the same representation (regex, NFA, or DFA)
-as $lang1.
-
-=item $lang1-E<gt>difference($lang2)
-
-Returns a regular language object that is the set difference of $lang1 and
-$lang2. Equivalent to
-
- $lang1->intersect($lang2->complement)
-
-The return value will have the same representation (regex, NFA, or DFA)
-as $lang1.
-
-=item $lang-E<gt>kleene
-
-=item $lang-E<gt>star
-
-Returns a regular language object for the Kleene star of $lang. The return
-value will have the same representation (regex, NFA, or DFA) as $lang.
-
-=item $lang-E<gt>complement
-
-Returns a regular language object for the complement of $lang. The return
-value will have the same representation (regex, NFA, or DFA) as $lang.
-
-=item $lang-E<gt>reverse
-
-Returns a regular language object for the stringwise reversal of $lang.
-The return value will have the same representation (regex, NFA, or DFA)
-as $lang.
-
-=back
-
-=head2 Decision Properties
-
-=over
-
-=item $lang-E<gt>is_finite
-
-=item $lang-E<gt>is_infinite
-
-Returns a boolean value indicating whether $lang represents a
-finite/infinite language.
-
-=item $lang-E<gt>is_empty
-
-Returns a boolean value indicating whether $lang represents the empty
-language.
-
-=item $lang1-E<gt>equals($lang2)
-
-Returns a boolean value indicating whether $lang1 and $lang2 are
-representations of the same language.
-
-=item $lang1-E<gt>is_subset_of($lang2)
-
-Returns a boolean value indicating whether $lang1 is a subset of
-$lang2.
-
-=item $lang-E<gt>contains($string)
-
-Returns a boolean value indicating whether $string is in the language
-represented by $lang.
-
-=back
-
-=head1 AUTHORS & ACKNOWLEDGEMENTS
-
-FLAT is written by Mike Rosulek E<lt>mike at mikero dot comE<gt> and Brett
-Estrade E<lt>estradb at gmail dot comE<gt>.
-
-The initial version (FLAT::Legacy) by Brett Estrade was work towards an MS
-thesis at the University of Southern Mississippi.
-
-=head1 LICENSE
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself.
-
-=head1 MORE INFO
-
-Please visit the Wiki at http://www.0x743.com/flat
diff --git a/lib/FLAT/CMD.pm b/lib/FLAT/CMD.pm
deleted file mode 100644
index 5bd0e2d..0000000
--- a/lib/FLAT/CMD.pm
+++ /dev/null
@@ -1,533 +0,0 @@
-package FLAT::CMD;
-use FLAT;
-use FLAT::Regex;
-use FLAT::NFA;
-use FLAT::DFA;
-use Carp;
-
-=head1 NAME
-
-CMD - Commandline interface for the Formal Language & Automata Toolkit
-
-=head1 SYNOPSIS
-
-CMD.pm is provides an interface to the C<fash> commandline utility that offers
-certain features implemented in FLAT. Consequently, this interface is also
-available using the C<perl -MFLAT::CMD -e func> paradigm, but C<fash> makes
-things a lot more convenient.
-
-=head1 USAGE
-
-All regular language objects in FLAT implement the following methods.
-Specific regular language representations (regex, NFA, DFA) may implement
-additional methods that are outlined in the repsective POD pages.
-
-=cut
-
-# Support for perl one liners - like what CPAN.pm uses #<- should move all to another file
-use base 'Exporter'; #instead of: use Exporter (); @ISA = 'Exporter';
-use vars qw(@EXPORT $AUTOLOAD);
-
-@EXPORT = qw(compare dump dfa2gv nfa2gv pfa2gv dfa2undgv nfa2undgv pfa2undgv dfa2digraph
- nfa2digraph pfa2digraph dfa2undirected nfa2undirected pfa2undirected random_pre random_re
- savedfa test help
- );
-
-sub AUTOLOAD {
- my($l) = $AUTOLOAD;
- $l =~ s/.*:://;
- my(%EXPORT);
- @EXPORT{@EXPORT} = '';
- if (exists $EXPORT{$l}){
- FLAT::CMD->$l(@_);
- }
-}
-
-sub help {
-print <<END
-__________ .__ ___________.____ ___________
-\______ \ ___________| | \_ _____/| | _____\__ ___/
- | ___// __ \_ __ \ | | __) | | \__ \ | |
- | | \ ___/| | \/ |__ | \ | |___ / __ \| |
- |____| \___ >__| |____/ \___ / |_______ (____ /____|
- \/ \/ \/ \/
-
- Everything is wrt parallel regular expressions, i.e.,
- with the addtional shuffle operator, "&". All this
- means is that you can use the ambersand (&) as a symbol
- in the regular expressions you submit because it will be
- detected as an operator.That said, if you avoid using
- the "&" operator, you can forget about all that shuffle
- business.
-
-%perl -MFLAT::CMD -e
- "somestrings" 're1' # creates all valid strings via acyclic path, no cycles yet
- "compare 're1','re2'" # comares 2 regexs | see note [2]
- "dump 're1'" # dumps parse trees | see note[1]
- "dfa2gv 're1'" # dumps graphviz digraph desc | see note[1]
- "nfa2gv 're1'" # dumps graphviz digraph desc | see note[1]
- "pfa2gv 're1'" # dumps graphviz digraph desc | see note[1]
- "dfa2undgv 're1'" # dumps graphviz undirected graph desc | see note[1]
- "nfa2undgv 're1'" # dumps graphviz undirected graph desc | see note[1]
- "pfa2undgv 're1'" # dumps graphviz undirected graph desc | see note[1]
- "dfa2digraph 're1'" # dumps directed graph without transitions
- "nfa2digraph 're1'" # dumps directed graph without transitions
- "pfa2digraph 're1'" # dumps directed graph without transitions
- "dfa2undirected 're1'" # dumps undirected graph without transitions
- "nfa2undirected 're1'" # dumps undirected graph without transitions
- "pfa2undirected 're1'" # dumps undirected graph without transitions
- random_pre
- random_re
- "savedfa 're1'" # converts PRE to min dfa, then serializes to disk
- "test 'regex' 'string1'" # give a regex, reports if subsequent strings are valid
- help
-
-NOTES:
-[1] This means you could presumably do something like the following:
- %perl -MFLAT -e command < text_file_with_1_regex_per_line.txt
- ^^^^^^^ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-[2] This command compares the minimal DFAs of each regular expression;
- if there exists a exact 1-1 mapping of symbols, states, and
- transitions then the DFAs are considered equal. This means that
- "abc" will be equal to "def" To make matters more confusing, "ab+ac"
- would be equivalent to "xy+xz"; or worse yet, "z(x+y)". So to the
- 'compare' command, "ab+ac" == "xy+xz" == "z(x+y)". This however
- does not translate into the situation where "ab+ac" will accept
- the same LITERAL strings as "z(x+y)" because the symbols are obviously
- different.
-
-CREDITS:
-Blockhead, CPAN.pm (for the example of how to implement these one liners),
-and #perl on irc.freenode.net for pointing out something I missed when
-trying to copy CPAN one liner majik.
-
-Perl FLAT and all included modules are released under the same terms as Perl
-itself. Cheers.
-
-SEE:
-http://www.0x743.com/flat
-
-END
-}
-
-# save to a dat file
-sub savedfa {
- my $PRE = shift;
- # neat a better way to get input via stdin
- if (!$PRE) {
- while (<>) {
- chomp;
- $PRE = $_;
- last;
- }
- }
- use FLAT::Regex::WithExtraOps;
- use FLAT::PFA;
- use FLAT::NFA;
- use FLAT::DFA;
- use Storable;
- # caches results, loads them in if detexted
- my $dfa = FLAT::Regex::WithExtraOps->new($PRE)->as_pfa->as_nfa->as_dfa->as_min_dfa->trim_sinks;
- store $dfa, "$PRE.dat";
-}
-
-# dumps directed graph using Kundu notation
-# Usage:
-# perl -MFLAT -e "pfa2directed('a&b&c&d*e*')"
-sub test {
- use FLAT::Regex::WithExtraOps;
- use FLAT::PFA;
- use FLAT::NFA;
- use FLAT::DFA;
- # handles multiple strings; first is considered the regex
- if (@_)
- { my $FA = FLAT::Regex::WithExtraOps->new(shift @_)->as_pfa()->as_nfa->as_dfa();
- foreach (@_)
- { if ($FA->is_valid_string($_)) {
- print "(+): $_\n";
- } else {
- print "(-): $_\n";
- }
- }
- } else {
- my $FA;
- while (<STDIN>) {
- chomp;
- if ($. == 1) { #<-- uses first line as regex!
- $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa->as_dfa();
- } else {
- if ($FA->is_valid_string($_)) {
- print "(+): $_\n";
- } else {
- print "(-): $_\n";
- }
- }
- }
- }
-}
-
-# dumps parse tree
-# Usage:
-# perl -MFLAT -e "dump('re1','re2',...,'reN')"
-# perl -MFLAT -e dump < list_of_regexes.dat
-sub dump {
- use FLAT::Regex::WithExtraOps;
- use Data::Dumper;
- if (@_)
- { foreach (@_)
- { my $PRE = FLAT::Regex::WithExtraOps->new($_);
- print Dumper($PRE); }}
- else
- { while (<STDIN>)
- { chomp;
- my $PRE = FLAT::Regex::WithExtraOps->new($_);
- print Dumper($PRE); }
- }
-}
-
-# dumps graphviz notation
-# Usage:
-# perl -MFLAT -e "dfa2gv('a&b&c&d*e*')"
-sub dfa2gv {
- use FLAT::Regex::WithExtraOps;
- use FLAT::DFA;
- use FLAT::NFA;
- use FLAT::PFA;
- if (@_)
- { foreach (@_)
- { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa()->as_min_dfa()->trim_sinks();
- print $FA->as_graphviz;} }
- else
- { while (<STDIN>)
- { chomp;
- my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa()->trim_sinks();
- print $FA->as_graphviz;}
- }
-}
-
-# dumps graphviz notation
-# Usage:
-# perl -MFLAT -e "nfa2gv('a&b&c&d*e*')"
-sub nfa2gv {
- use FLAT::Regex::WithExtraOps;
- use FLAT::DFA;
- use FLAT::NFA;
- use FLAT::PFA;
- if (@_)
- { foreach (@_)
- { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
- print $FA->as_graphviz;} }
- else
- { while (<STDIN>)
- { chomp;
- my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
- print $FA->as_graphviz;}
- }
-}
-
-# dumps graphviz notation
-# Usage:
-# perl -MFLAT -e "pfa2gv('a&b&c&d*e*')"
-sub pfa2gv {
- use FLAT::Regex::WithExtraOps;
- use FLAT::PFA;
- if (@_)
- { foreach (@_)
- { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
- print $FA->as_graphviz;} }
- else
- { while (<STDIN>)
- { chomp;
- my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
- print $FA->as_graphviz;}
- }
-}
-
-#as_undirected_graphviz
-
-# dumps graphviz notation
-# Usage:
-# perl -MFLAT -e "dfa2undgv('a&b&c&d*e*')"
-sub dfa2undgv {
- use FLAT::Regex::WithExtraOps;
- use FLAT::DFA;
- use FLAT::NFA;
- use FLAT::PFA;
- if (@_)
- { foreach (@_)
- { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa()->as_min_dfa()->trim_sinks();
- print $FA->as_undirected_graphviz;} }
- else
- { while (<STDIN>)
- { chomp;
- my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa()->trim_sinks();
- print $FA->as_undirected_graphviz;}
- }
-}
-
-# dumps graphviz notation
-# Usage:
-# perl -MFLAT -e "nfa2undgv('a&b&c&d*e*')"
-sub nfa2undgv {
- use FLAT::Regex::WithExtraOps;
- use FLAT::DFA;
- use FLAT::NFA;
- use FLAT::PFA;
- if (@_)
- { foreach (@_)
- { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
- print $FA->as_undirected_graphviz;} }
- else
- { while (<STDIN>)
- { chomp;
- my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
- print $FA->as_undirected_graphviz;}
- }
-}
-
-# dumps graphviz notation
-# Usage:
-# perl -MFLAT -e "pfa2undgv('a&b&c&d*e*')"
-sub pfa2undgv {
- use FLAT::Regex::WithExtraOps;
- use FLAT::PFA;
- if (@_)
- { foreach (@_)
- { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
- print $FA->as_undirected_graphviz;} }
- else
- { while (<STDIN>)
- { chomp;
- my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
- print $FA->as_undirected_graphviz;}
- }
-}
-
-# dumps directed graph using Kundu notation
-# Usage:
-# perl -MFLAT -e "dfa2directed('a&b&c&d*e*')"
-sub dfa2digraph {
- use FLAT::Regex::WithExtraOps;
- use FLAT::DFA;
- use FLAT::NFA;
- use FLAT::PFA;
- # trims sink states from min-dfa since transitions are gone
- if (@_)
- { foreach (@_)
- { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa->trim_sinks();
- print $FA->as_digraph;} }
- else
- { while (<STDIN>)
- { chomp;
- my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa->trim_sinks();
- print $FA->as_digraph;}
- }
- print "\n";
-}
-
-# dumps directed graph using Kundu notation
-# Usage:
-# perl -MFLAT -e "nfa2directed('a&b&c&d*e*')"
-sub nfa2digraph {
- use FLAT::Regex::WithExtraOps;
- use FLAT::DFA;
- use FLAT::NFA;
- use FLAT::PFA;
- if (@_)
- { foreach (@_)
- { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
- print $FA->as_digraph;} }
- else
- { while (<STDIN>)
- { chomp;
- my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
- print $FA->as_digraph;}
- }
- print "\n";
-}
-
-# dumps directed graph using Kundu notation
-# Usage:
-# perl -MFLAT -e "pfa2directed('a&b&c&d*e*')"
-sub pfa2digraph {
- use FLAT::Regex::WithExtraOps;
- use FLAT::PFA;
- if (@_)
- { foreach (@_)
- { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
- print $FA->as_digraph;} }
- else
- { while (<STDIN>)
- { chomp;
- my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
- print $FA->as_digraph;}
- }
- print "\n";
-}
-
-# dumps undirected graph using Kundu notation
-# Usage:
-# perl -MFLAT -e "dfa2undirected('a&b&c&d*e*')"
-sub dfa2undirected {
- use FLAT::Regex::WithExtraOps;
- use FLAT::DFA;
- use FLAT::NFA;
- use FLAT::PFA;
- # trims sink states from min-dfa since transitions are gone
- if (@_)
- { foreach (@_)
- { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa->trim_sinks();
- print $FA->as_undirected;} }
- else
- { while (<STDIN>)
- { chomp;
- my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa->trim_sinks();
- print $FA->as_undirected;}
- }
- print "\n";
-}
-
-# dumps undirected graph using Kundu notation
-# Usage:
-# perl -MFLAT -e "nfa2undirected('a&b&c&d*e*')"
-sub nfa2undirected {
- use FLAT::Regex::WithExtraOps;
- use FLAT::DFA;
- use FLAT::NFA;
- use FLAT::PFA;
- if (@_)
- { foreach (@_)
- { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
- print $FA->as_undirected;} }
- else
- { while (<STDIN>)
- { chomp;
- my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
- print $FA->as_undirected;}
- }
- print "\n";
-}
-
-# dumps undirected graph using Kundu notation
-# Usage:
-# perl -MFLAT -e "pfa2undirected('a&b&c&d*e*')"
-sub pfa2undirected {
- use FLAT::Regex::WithExtraOps;
- use FLAT::PFA;
- if (@_)
- { foreach (@_)
- { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
- print $FA->as_undirected;} }
- else
- { while (<STDIN>)
- { chomp;
- my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
- print $FA->as_undirected;}
- }
- print "\n";
-}
-
-# compares 2 give PREs
-# Usage:
-# perl -MFLAT -e "compare('a','a&b&c&d*e*')" #<-- no match, btw
-sub compare {
- use FLAT::Regex::WithExtraOps;
- use FLAT::DFA;
- use FLAT::PFA;
- my $PFA1 = FLAT::Regex::WithExtraOps->new(shift)->as_pfa();
- my $PFA2 = FLAT::Regex::WithExtraOps->new(shift)->as_pfa();
- my $DFA1 = $PFA1->as_nfa->as_min_dfa;
- my $DFA2 = $PFA2->as_nfa->as_min_dfa;
- if ($DFA1->equals($DFA2)) {
- print "Yes\n";
- } else {
- print "No\n";
- }
-}
-
-# prints random PRE
-# Usage:
-# perl -MFLAT -e random_pre
-sub random_pre {
- my $and_chance = shift;
- # skirt around deep recursion warning annoyance
- local $SIG{__WARN__} = sub { $_[0] =~ /^Deep recursion/ or warn $_[0] };
- srand $$;
- my %CMDLINEOPTS = ();
- # Percent chance of each operator occuring
- $CMDLINEOPTS{LENGTH} = 32;
- $CMDLINEOPTS{OR} = 6;
- $CMDLINEOPTS{STAR} = 10;
- $CMDLINEOPTS{OPEN} = 5;
- $CMDLINEOPTS{CLOSE} = 0;
- $CMDLINEOPTS{n} = 1;
- $CMDLINEOPTS{AND} = 10; #<-- default
- $CMDLINEOPTS{AND} = $and_chance if ($and_chance == 0); #<-- to make it just an re (no shuffle)
-
-
- my $getRandomChar = sub {
- my $ch = '';
- # Get a random character between 0 and 127.
- do {
- $ch = int(rand 2);
- } while ($ch !~ m/[a-zA-Z0-9]/);
- return $ch;
- };
-
- my $getRandomRE = sub {
- my $str = '';
- my @closeparens = ();
- for (1..$CMDLINEOPTS{LENGTH}) {
- $str .= $getRandomChar->();
- # % chance of an "or"
- if (int(rand 100) < $CMDLINEOPTS{OR}) {
- $str .= "|1";
- } elsif (int(rand 100) < $CMDLINEOPTS{AND}) {
- $str .= "&0";
- } elsif (int(rand 100) < $CMDLINEOPTS{STAR}) {
- $str .= "*1";
- } elsif (int(rand 100) < $CMDLINEOPTS{OPEN}) {
- $str .= "(";
- push(@closeparens,'0101)');
- } elsif (int(rand 100) < $CMDLINEOPTS{CLOSE} && @closeparens) {
- $str .= pop(@closeparens);
- }
- }
- # empty out @closeparens if there are still some left
- if (@closeparens) {
- $str .= join('',@closeparens);
- }
- return $str;
- };
-
- for (1..$CMDLINEOPTS{n}) {
- print $getRandomRE->(),"\n";
- }
-}
-
-# prints random RE (no & operator)
-# Usage:
-# perl -MFLAT -e random_re
-sub random_re {
- shift->random_pre(0);
-}
-
-1;
-
-__END__
-
-=head1 AUTHORS & ACKNOWLEDGEMENTS
-
-FLAT is written by Mike Rosulek E<lt>mike at mikero dot comE<gt> and
-Brett Estrade E<lt>estradb at gmail dot comE<gt>.
-
-The initial version (FLAT::Legacy) by Brett Estrade was work towards an
-MS thesis at the University of Southern Mississippi.
-
-Please visit the Wiki at http://www.0x743.com/flat
-
-=head1 LICENSE
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself.
-
diff --git a/lib/FLAT/CMD/AcyclicStrings.pm b/lib/FLAT/CMD/AcyclicStrings.pm
deleted file mode 100644
index ebc8840..0000000
--- a/lib/FLAT/CMD/AcyclicStrings.pm
+++ /dev/null
@@ -1,54 +0,0 @@
-# all strings available via acyclic path from the DFA start state to any all of the final states
-
-package FLAT::CMD::AcyclicStrings;
-use base 'FLAT::CMD';
-use FLAT;
-use FLAT::Regex::WithExtraOps;
-use FLAT::PFA;
-use FLAT::NFA;
-use FLAT::DFA;
-use Storable;
-use Carp;
-
-# Support for perl one liners - like what CPAN.pm uses #<- should move all to another file
-use base 'Exporter'; #instead of: use Exporter (); @ISA = 'Exporter';
-use vars qw(@EXPORT $AUTOLOAD);
-
-@EXPORT = qw(as_strings);
-
-sub AUTOLOAD {
- my($l) = $AUTOLOAD;
- $l =~ s/.*:://;
- my(%EXPORT);
- @EXPORT{@EXPORT} = '';
- if (exists $EXPORT{$l}){
- FLAT::CMD->$l(@_);
- }
-}
-
-use vars qw(%nodes %dflabel %backtracked %low $lastDFLabel @string $dfa);
-# acyclic - no cycles
-sub as_strings {
- my $PRE = shift;
- # neat a better way to get input via stdin
- if (!$PRE) {
- while (<>) {
- chomp;
- $PRE = $_;
- last;
- }
- }
- # caches results, loads them in if detexted
- my $RE = FLAT::Regex::WithExtraOps->new($PRE);
- printf("%s\n",$RE->as_string());
- if (!-e "$PRE.dat") {
- $dfa = $RE->as_pfa->as_nfa->as_dfa->as_min_dfa->trim_sinks;
- #store $dfa, "$PRE.dat";
- } else {
- print STDERR "$PRE.dat found..";
- $dfa = retrieve "$PRE.dat";
- }
- $dfa->as_acyclic_strings();
-}
-
-1;
diff --git a/lib/FLAT/CMD/DFTStrings.pm b/lib/FLAT/CMD/DFTStrings.pm
deleted file mode 100644
index 9dc5a59..0000000
--- a/lib/FLAT/CMD/DFTStrings.pm
+++ /dev/null
@@ -1,55 +0,0 @@
-# all strings available via depth first traversal, including back edges that happen to land on an accepting state
-
-package FLAT::CMD::DFTStrings;
-use base 'FLAT::CMD';
-use FLAT;
-use FLAT::Regex::WithExtraOps;
-use FLAT::PFA;
-use FLAT::NFA;
-use FLAT::DFA;
-use Storable;
-use Carp;
-
-# Support for perl one liners - like what CPAN.pm uses #<- should move all to another file
-use base 'Exporter'; #instead of: use Exporter (); @ISA = 'Exporter';
-use vars qw(@EXPORT $AUTOLOAD);
-
-@EXPORT = qw(as_strings);
-
-sub AUTOLOAD {
- my($l) = $AUTOLOAD;
- $l =~ s/.*:://;
- my(%EXPORT);
- @EXPORT{@EXPORT} = '';
- if (exists $EXPORT{$l}){
- FLAT::CMD->$l(@_);
- }
-}
-
-use vars qw(%nodes %dflabel %backtracked %low $lastDFLabel @string $dfa);
-# acyclic - no cycles
-sub as_strings {
- my $PRE = shift;
- # neat a better way to get input via stdin
- if (!$PRE) {
- while (<>) {
- chomp;
- $PRE = $_;
- last;
- }
- }
- # caches results, loads them in if detexted
- my $RE = FLAT::Regex::WithExtraOps->new($PRE);
- printf("%s\n",$RE->as_string());
- if (!-e "$PRE.dat") {
- $dfa = $RE->as_pfa->as_nfa->as_dfa->as_min_dfa->trim_sinks;
- #store $dfa, "$PRE.dat";
- } else {
- print STDERR "$PRE.dat found..";
- $dfa = retrieve "$PRE.dat";
- }
-
- $dfa->as_dft_strings(shift);
-}
-
-1;
diff --git a/lib/FLAT/DFA.pm b/lib/FLAT/DFA.pm
deleted file mode 100644
index f96c9fb..0000000
--- a/lib/FLAT/DFA.pm
+++ /dev/null
@@ -1,557 +0,0 @@
-package FLAT::DFA;
-
-use strict;
-use base 'FLAT::NFA';
-use Storable qw(dclone);
-use Carp;
-$|++;
-
-sub set_starting {
- my $self = shift;
- $self->SUPER::set_starting(@_);
-
- my $num = () = $self->get_starting;
- confess "DFA must have exactly one starting state"
- if $num != 1;
-}
-
-sub complement {
- my $self = $_[0]->clone;
-
- for my $s ($self->get_states) {
- $self->is_accepting($s)
- ? $self->unset_accepting($s)
- : $self->set_accepting($s);
- }
-
- return $self;
-}
-
-sub _TUPLE_ID { join "\0", @_ }
-sub _uniq { my %seen; grep { !$seen{$_}++ } @_; }
-
-## this method still needs more work..
-sub intersect {
- my @dfas = map { $_->as_dfa } @_;
-
- my $return = FLAT::DFA->new;
- my %newstates;
- my @alpha = _uniq( map { $_->alphabet } @dfas );
-
- $_->_extend_alphabet(@alpha) for @dfas;
-
- my @start = map { $_->get_starting } @dfas;
- my $start = $newstates{ _TUPLE_ID(@start) } = $return->add_states(1);
- $return->set_starting($start);
- $return->set_accepting($start)
- if ! grep { ! $dfas[$_]->is_accepting( $start[$_] ) } 0 .. $#dfas;
-
- my @queue = (\@start);
- while (@queue) {
- my @tuple = @{ shift @queue };
-
- for my $char (@alpha) {
- my @next = map { $dfas[$_]->successors( $tuple[$_], $char ) }
- 0 .. $#dfas;
-
- #warn "[@tuple] --> [@next] via $char\n";
-
- if (not exists $newstates{ _TUPLE_ID(@next) }) {
- my $s = $newstates{ _TUPLE_ID(@next) } = $return->add_states(1);
- $return->set_accepting($s)
- if ! grep { ! $dfas[$_]->is_accepting( $next[$_] ) } 0 .. $#dfas;
- push @queue, \@next;
- }
-
- $return->add_transition( $newstates{ _TUPLE_ID(@tuple) },
- $newstates{ _TUPLE_ID(@next) },
- $char );
- }
- }
-
- return $return;
-}
-
-# this is meant to enforce 1 starting state for a DFA, but it is getting us into trouble
-# when a DFA object calls unset_starting
-sub unset_starting {
- my $self = shift;
- $self->SUPER::unset_starting(@_);
- my $num = () = $self->unset_starting;
- croak "DFA must have exactly one starting state"
- if $num != 1;
-}
-
-#### transformations
-
-sub trim_sinks {
- my $self = shift;
- my $result = $self->clone();
- foreach my $state ($self->array_complement([$self->get_states()],[$self->get_accepting()])) {
- my @ret = $self->successors($state,[$self->alphabet]);
- if (@ret) {
- if ($ret[0] == $state) {
- $result->delete_states($state) if ($result->is_state($state));
- }
- }
- }
- return $result;
-}
-
-sub as_min_dfa {
-
- my $self = shift()->clone;
- my $N = $self->num_states;
- my @alphabet = $self->alphabet;
-
- my ($start) = $self->get_starting;
- my %final = map { $_ => 1 } $self->get_accepting;
-
- my @equiv = map [ (0) x ($_+1), (1) x ($N-$_-1) ], 0 .. $N-1;
-
- while (1) {
- my $changed = 0;
- for my $s1 (0 .. $N-1) {
- for my $s2 (grep { $equiv[$s1][$_] } 0 .. $N-1) {
-
- if ( 1 == grep defined, @final{$s1, $s2} ) {
- $changed = 1;
- $equiv[$s1][$s2] = 0;
- next;
- }
-
- for my $char (@alphabet) {
- my @t = sort { $a <=> $b } $self->successors([$s1,$s2], $char);
- next if @t == 1;
-
- if (not $equiv[ $t[0] ][ $t[1] ]) {
- $changed = 1;
- $equiv[$s1][$s2] = 0;
- }
- }
- }}
-
- last if !$changed;
- }
- my $result = (ref $self)->new;
- my %newstate;
- my @classes;
- for my $s (0 .. $N-1) {
- next if exists $newstate{$s};
-
- my @c = ( $s, grep { $equiv[$s][$_] } 0 .. $N-1 );
- push @classes, \@c;
-
- @newstate{@c} = ( $result->add_states(1) ) x @c;
- }
-
- for my $c (@classes) {
- my $s = $c->[0];
- for my $char (@alphabet) {
- my ($next) = $self->successors($s, $char);
- $result->add_transition( $newstate{$s}, $newstate{$next}, $char );
- }
- }
-
- $result->set_starting( $newstate{$start} );
- $result->set_accepting( $newstate{$_} )
- for $self->get_accepting;
-
- $result;
-
-}
-
-# the validity of a given string <-- executes symbols over DFA
-# if there is not transition for given state and symbol, it fails immediately
-# if the current state we're in is not final when symbols are exhausted, then it fails
-
-sub is_valid_string {
- my $self = shift;
- my $string = shift;
- chomp $string;
- my $OK = undef;
- my @stack = split('',$string);
- # this is confusing all funcs return arrays
- my @current = $self->get_starting();
- my $current = pop @current;
- foreach (@stack) {
- my @next = $self->successors($current,$_);
- if (!@next) {
- return $OK; #<--returns undef bc no transition found
- }
- $current = $next[0];
- }
- $OK++ if ($self->is_accepting($current));
- return $OK;
-}
-
-#
-# Experimental!!
-#
-
-# DFT stuff in preparation for DFA pump stuff;
-sub as_node_list {
- my $self = shift;
- my %node = ();
- for my $s1 ($self->get_states) {
- $node{$s1} = {}; # initialize
- for my $s2 ($self->get_states) {
- my $t = $self->get_transition($s1, $s2);
- if (defined $t) {
- # array of symbols that $s1 will go to $s2 on...
- push(@{$node{$s1}{$s2}},split(',',$t->as_string));
- }
- }
- }
- return %node;
-}
-
-sub as_acyclic_strings {
- my $self = shift;
- my %dflabel = (); # lookup table for dflable
- my %backtracked = (); # lookup table for backtracked edges
- my $lastDFLabel = 0;
- my @string = ();
- my %nodes = $self->as_node_list();
- # output format is the actual PRE followed by all found strings
- $self->acyclic($self->get_starting(),\%dflabel,$lastDFLabel,\%nodes,\@string);
-}
-
-sub acyclic {
- my $self = shift;
- my $startNode = shift;
- my $dflabel_ref = shift;
- my $lastDFLabel = shift;
- my $nodes = shift;
- my $string = shift;
- # tree edge detection
- if (!exists($dflabel_ref->{$startNode})) {
- $dflabel_ref->{$startNode} = ++$lastDFLabel; # the order inwhich this link was explored
- foreach my $adjacent (keys(%{$nodes->{$startNode}})) {
- if (!exists($dflabel_ref->{$adjacent})) { # initial tree edge
- foreach my $symbol (@{$nodes->{$startNode}{$adjacent}}) {
- push(@{$string},$symbol);
- $self->acyclic($adjacent,\%{$dflabel_ref},$lastDFLabel,\%{$nodes},\@{$string});
- if ($self->array_is_subset([$adjacent],[$self->get_accepting()])) { #< proof of concept
- printf("%s\n",join('',@{$string}));
- }
- pop(@{$string});
- }
- }
- }
- }
- # remove startNode entry to facilitate acyclic path determination
- delete($dflabel_ref->{$startNode});
- #$lastDFLabel--;
- return;
-};
-
-sub as_dft_strings {
- my $self = shift;
- my $depth = 1;
- $depth = shift if (1 < $_[0]);
- my %dflabel = (); # scoped lookup table for dflable
- my %nodes = $self->as_node_list();
- foreach (keys(%nodes)) {
- $dflabel{$_} = []; # initialize container (array) for multiple dflables for each node
- }
- my $lastDFLabel = 0;
- my @string = ();
- $self->dft($self->get_starting(),[$self->get_accepting()],\%dflabel,$lastDFLabel,\%nodes,\@string,$depth);
-}
-
-sub dft {
- my $self = shift;
- my $startNode = shift;
- my $goals_ref = shift;
- my $dflabel_ref = shift;
- my $lastDFLabel = shift;
- my $nodes = shift;
- my $string = shift;
- my $DEPTH = shift;
- # add start node to path
- my $c1 = @{$dflabel_ref->{$startNode}}; # get number of elements
- if ($DEPTH >= $c1) {
- push(@{$dflabel_ref->{$startNode}},++$lastDFLabel);
- foreach my $adjacent (keys(%{$nodes->{$startNode}})) {
- my $c2 = @{$dflabel_ref->{$adjacent}};
- if ($DEPTH > $c2) { # "initial" tree edge
- foreach my $symbol (@{$nodes->{$startNode}{$adjacent}}) {
- push(@{$string},$symbol);
- $self->dft($adjacent,[@{$goals_ref}],$dflabel_ref,$lastDFLabel,$nodes,[@{$string}],$DEPTH);
- # assumes some base path found
- if ($self->array_is_subset([$adjacent],[@{$goals_ref}])) {
- printf("%s\n",join('',@{$string}));
- }
- pop(@{$string});
- }
- }
- } # remove startNode entry to facilitate acyclic path determination
- pop(@{$dflabel_ref->{$startNode}});
- $lastDFLabel--;
- }
-};
-
-#
-# String gen using iterators (still experimental)
-#
-
-sub get_acyclic_sub {
- my $self = shift;
- my ($start,$nodelist_ref,$dflabel_ref,$string_ref,$accepting_ref,$lastDFLabel) = @_;
- my @ret = ();
- foreach my $adjacent (keys(%{$nodelist_ref->{$start}})) {
- $lastDFLabel++;
- if (!exists($dflabel_ref->{$adjacent})) {
- $dflabel_ref->{$adjacent} = $lastDFLabel;
- foreach my $symbol (@{$nodelist_ref->{$start}{$adjacent}}) {
- push(@{$string_ref},$symbol);
- my $string_clone = dclone($string_ref);
- my $dflabel_clone = dclone($dflabel_ref);
- push(@ret,sub { return $self->get_acyclic_sub($adjacent,$nodelist_ref,$dflabel_clone,$string_clone,$accepting_ref,$lastDFLabel); });
- pop @{$string_ref};
- }
- }
-
- }
- return {substack=>[@ret],
- lastDFLabel=>$lastDFLabel,
- string => ($self->array_is_subset([$start],[@{$accepting_ref}]) ? join('',@{$string_ref}) : undef)};
-}
-sub init_acyclic_iterator {
- my $self = shift;
- my %dflabel = ();
- my @string = ();
- my $lastDFLabel = 0;
- my %nodelist = $self->as_node_list();
- my @accepting = $self->get_accepting();
- # initialize
- my @substack = ();
- my $r = $self->get_acyclic_sub($self->get_starting(),\%nodelist,\%dflabel,\@string,\@accepting,$lastDFLabel);
- push(@substack,@{$r->{substack}});
- return sub {
- while (1) {
- if (!@substack) {
- return undef;
- }
- my $s = pop @substack;
- my $r = $s->();
- push(@substack,@{$r->{substack}});
- if ($r->{string}) {
- return $r->{string};
- }
- }
- }
-}
-
-sub new_acyclic_string_generator {
- my $self = shift;
- return $self->init_acyclic_iterator();
-}
-
-sub get_deepdft_sub {
- my $self = shift;
- my ($start,$nodelist_ref,$dflabel_ref,$string_ref,$accepting_ref,$lastDFLabel,$max) = @_;
- my @ret = ();
- my $c1 = @{$dflabel_ref->{$start}};
- if ($c1 < $max) {
- push(@{$dflabel_ref->{$start}},++$lastDFLabel);
- foreach my $adjacent (keys(%{$nodelist_ref->{$start}})) {
- my $c2 = @{$dflabel_ref->{$adjacent}};
- if ($c2 < $max) {
- foreach my $symbol (@{$nodelist_ref->{$start}{$adjacent}}) {
- push(@{$string_ref},$symbol);
- my $string_clone = dclone($string_ref);
- my $dflabel_clone = dclone($dflabel_ref);
- push(@ret,sub { return $self->get_deepdft_sub($adjacent,$nodelist_ref,$dflabel_clone,$string_clone,$accepting_ref,$lastDFLabel,$max); });
- pop @{$string_ref};
- }
- }
- }
- }
- return {substack=>[@ret], lastDFLabel=>$lastDFLabel, string => ($self->array_is_subset([$start],[@{$accepting_ref}]) ? join('',@{$string_ref}) : undef)};
-}
-
-sub init_deepdft_iterator {
- my $self = shift;
- my $MAXLEVEL = shift;
- my %dflabel = ();
- my @string = ();
- my $lastDFLabel = 0;
- my %nodelist = $self->as_node_list();
- foreach my $node (keys(%nodelist)) {
- $dflabel{$node} = []; # initializes anonymous arrays for all nodes
- }
- my @accepting = $self->get_accepting();
- # initialize
- my @substack = ();
- my $r = $self->get_deepdft_sub($self->get_starting(),\%nodelist,\%dflabel,\@string,\@accepting,$lastDFLabel,$MAXLEVEL);
- push(@substack,@{$r->{substack}});
- return sub {
- while (1) {
- if (!@substack) {
- return undef;
- }
- my $s = pop @substack;
- my $r = $s->();
- push(@substack,@{$r->{substack}});
- if ($r->{string}) {
- return $r->{string};
- }
- }
- }
-}
-
-sub new_deepdft_string_generator {
- my $self = shift;
- my $MAXLEVEL = (@_ ? shift : 1);
- return $self->init_deepdft_iterator($MAXLEVEL);
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-FLAT::DFA - Deterministic finite automata
-
-=head1 SYNOPSIS
-
-A FLAT::DFA object is a finite automata whose transitions are labeled
-with single characters. Furthermore, each state has exactly one outgoing
-transition for each available label/character.
-
-=head1 USAGE
-
-In addition to implementing the interface specified in L<FLAT> and L<FLAT::NFA>,
-FLAT::DFA objects provide the following DFA-specific methods:
-
-=over
-
-=item $dfa-E<gt>unset_starting
-
-Because a DFA, by definition, must have only ONE starting state, this allows one to unset
-the current start state so that a new one may be set.
-
-=item $dfa-E<gt>trim_sinks
-
-This method returns a FLAT::DFA (though in theory an NFA) that is lacking a transition for
-all symbols from all states. This method eliminates all transitions from all states that lead
-to a sink state; it also eliminates the sink state.
-
-This has no affect on testing if a string is valid using C<FLAT::DFA::is_valid_string>,
-discussed below.
-
-=item $dfa-E<gt>as_min_dfa
-
-This method minimizes the number of states and transitions in the given DFA. The modifies
-the current/calling DFA object.
-
-=item $dfa-E<gt>is_valid_string($string)
-
-This method tests if the given string is accepted by the DFA.
-
-=item $dfa-E<gt>as_node_list
-
-This method returns a node list in the form of a hash. This node list may be viewed as a
-pure digraph, and is lacking in state names and transition symbols.
-
-=item $dfa-E<gt>as_acyclic_strings
-
-The method is B<deprecated>, and it is suggested that one not use it. It returns all
-valid strings accepted by the DFA by exploring all acyclic paths that go from the start
-state and end in an accepting state. The issue with this method is that it finds and
-returns all strings at once. The iterator described below is much more ideal for actual
-use in an application.
-
-=item $dfa-E<gt>as_dft_strings($depth)
-
-The method is B<deprecated>, and it is suggested that one not use it. It returns all
-valid strings accepted by the DFA using a depth first traversal. A valid string is formed
-when the traversal detects an accepting state, whether it is a terminal node or a node reached
-via a back edge. The issue with this method is that it finds and returns all strings at once.
-The iterator described below is much more ideal for actual use in an application.
-
-The argument, C<$depth> specifies how many times the traversal may actually pass through
-a previously visited node. It is therefore possible to safely explore DFAs that accept
-infinite languages.
-
-=item $dfa-E<gt>new_acyclic_string_generator
-
-This allows one to initialize an iterator that returns a valid string on each successive
-call of the sub-ref that is returned. It returns all valid strings accepted by the DFA by
-exploring all acyclic paths that go from the start state and end in an accepting state.
-
-Example:
-
- #!/usr/bin/env perl
- use strict;
- use FLAT::DFA;
- use FLAT::NFA;
- use FLAT::PFA;
- use FLAT::Regex::WithExtraOps;
-
- my $PRE = "abc&(def)*";
- my $dfa = FLAT::Regex::WithExtraOps->new($PRE)->as_pfa->as_nfa->as_dfa->as_min_dfa->trim_sinks;
- my $next = $dfa->new_acyclic_string_generator;
- print "PRE: $PRE\n";
- print "Acyclic:\n";
- while (my $string = $next->()) {
- print " $string\n";
- }
-
-=item $dfa-E<gt>new_deepdft_string_generator($depth)
-
-This allows one to initialize an iterator that returns a valid string on each successive
-call of the sub-ref that is returned. It returns all valid strings accepted by the DFA using a
-depth first traversal. A valid string is formed when the traversal detects an accepting state,
-whether it is a terminal node or a node reached via a back edge.
-
-The argument, C<$depth> specifies how many times the traversal may actually pass through
-a previously visited node. It is therefore possible to safely explore DFAs that accept
-infinite languages.
-
- #!/usr/bin/env perl
- use strict;
- use FLAT::DFA;
- use FLAT::NFA;
- use FLAT::PFA;
- use FLAT::Regex::WithExtraOps;
-
- my $PRE = "abc&(def)*";
- my $dfa = FLAT::Regex::WithExtraOps->new($PRE)->as_pfa->as_nfa->as_dfa->as_min_dfa->trim_sinks;
- my $next = $dfa->new_deepdft_string_generator();
- print "Deep DFT (default):\n";
- for (1..10) {
- while (my $string = $next->()) {
- print " $string\n";
- last;
- }
- }
-
- $next = $dfa->new_deepdft_string_generator(5);
- print "Deep DFT (5):\n";
- for (1..10) {
- while (my $string = $next->()) {
- print " $string\n";
- last;
- }
- }
-
-=back
-
-=head1 AUTHORS & ACKNOWLEDGEMENTS
-
-FLAT is written by Mike Rosulek E<lt>mike at mikero dot comE<gt> and
-Brett Estrade E<lt>estradb at gmail dot comE<gt>.
-
-The initial version (FLAT::Legacy) by Brett Estrade was work towards an
-MS thesis at the University of Southern Mississippi.
-
-Please visit the Wiki at http://www.0x743.com/flat
-
-=head1 LICENSE
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself.
diff --git a/lib/FLAT/FA.pm b/lib/FLAT/FA.pm
deleted file mode 100644
index dd77f50..0000000
--- a/lib/FLAT/FA.pm
+++ /dev/null
@@ -1,554 +0,0 @@
-package FLAT::FA;
-
-use strict;
-use base 'FLAT';
-use Carp;
-
-use FLAT::Transition;
-
-=head1 NAME
-
-FLAT::FA - Base class for regular finite automata
-
-=head1 SYNOPSIS
-
-A FLAT::FA object is a collection of states and transitions. Each state
-may be labeled as starting or accepting. Each transition between states
-is labeled with a transition object.
-
-=head1 USAGE
-
-FLAT::FA is a superclass that is not intended to be used directly. However,
-it does provide the following methods:
-
-=cut
-
-sub new {
- my $pkg = shift;
- bless {
- STATES => [],
- TRANS => [],
- ALPHA => {}
- }, $pkg;
-}
-
-sub get_states {
- my $self = shift;
- return 0 .. ($self->num_states - 1);
-}
-
-sub num_states {
- my $self = shift;
- return scalar @{ $self->{STATES} };
-}
-
-sub is_state {
- my ($self, $state) = @_;
- exists $self->{STATES}->[$state];
-}
-
-sub _assert_states {
- my ($self, @states) = @_;
- for (@states) {
- croak "'$_' is not a state" if not $self->is_state($_);
- }
-}
-sub _assert_non_states {
- my ($self, @states) = @_;
- for (@states) {
- croak "There is already a state called '$_'" if $self->is_state($_);
- }
-}
-
-sub delete_states {
- my ($self, @states) = @_;
-
- $self->_assert_states(@states);
-
- for my $s ( sort { $b <=> $a } @states ) {
- $self->_decr_alphabet($_)
- for @{ splice @{ $self->{TRANS} }, $s, 1 };
-
- $self->_decr_alphabet( splice @$_, $s, 1 )
- for @{ $self->{TRANS} };
-
- splice @{ $self->{STATES} }, $s, 1;
- }
-}
-
-sub add_states {
- my ($self, $num) = @_;
- my $id = $self->num_states;
-
- for my $s ( $id .. ($id+$num-1) ) {
- push @$_, undef for @{ $self->{TRANS} };
- push @{ $self->{TRANS} }, [ (undef) x ($s+1) ];
- push @{ $self->{STATES} }, {
- starting => 0,
- accepting => 0
- };
- }
-
- return wantarray ? ($id .. ($id+$num-1))
- : $id+$num-1;
-}
-
-##############
-
-sub is_starting {
- my ($self, $state) = @_;
- $self->_assert_states($state);
- return $self->{STATES}[$state]{starting};
-}
-sub set_starting {
- my ($self, @states) = @_;
- $self->_assert_states(@states);
- $self->{STATES}[$_]{starting} = 1 for @states;
-}
-sub unset_starting {
- my ($self, @states) = @_;
- $self->_assert_states(@states);
- $self->{STATES}[$_]{starting} = 0 for @states;
-}
-sub get_starting {
- my $self = shift;
- return grep { $self->is_starting($_) } $self->get_states;
-}
-
-##############
-
-sub is_accepting {
- my ($self, $state) = @_;
- $self->_assert_states($state);
- return $self->{STATES}[$state]{accepting};
-}
-sub set_accepting {
- my ($self, @states) = @_;
- $self->_assert_states(@states);
- $self->{STATES}[$_]{accepting} = 1 for @states;
-}
-sub unset_accepting {
- my ($self, @states) = @_;
- $self->_assert_states(@states);
- $self->{STATES}[$_]{accepting} = 0 for @states;
-}
-sub get_accepting {
- my $self = shift;
- return grep { $self->is_accepting($_) } $self->get_states;
-}
-
-###############
-
-sub _decr_alphabet {
- my ($self, $t) = @_;
- return if not defined $t;
- for ($t->alphabet) {
- delete $self->{ALPHA}{$_} if not --$self->{ALPHA}{$_};
- }
-}
-sub _incr_alphabet {
- my ($self, $t) = @_;
- return if not defined $t;
- $self->{ALPHA}{$_}++ for $t->alphabet;
-}
-
-sub set_transition {
- my ($self, $state1, $state2, @label) = @_;
- $self->remove_transition($state1, $state2);
-
- @label = grep defined, @label;
- return if not @label;
-
- my $t = $self->{TRANS_CLASS}->new(@label);
- $self->_incr_alphabet($t);
-
- $self->{TRANS}[$state1][$state2] = $t;
-}
-
-sub add_transition {
- my ($self, $state1, $state2, @label) = @_;
-
- @label = grep defined, @label;
- return if not @label;
-
- my $t = $self->get_transition($state1, $state2);
- $self->_decr_alphabet($t);
-
- if (!$t) {
- $t = $self->{TRANS}[$state1][$state2] = $self->{TRANS_CLASS}->new;
- }
-
- $t->add(@label);
- $self->_incr_alphabet($t);
-}
-
-sub get_transition {
- my ($self, $state1, $state2) = @_;
- $self->_assert_states($state1, $state2);
-
- $self->{TRANS}[$state1][$state2];
-}
-
-sub remove_transition {
- my ($self, $state1, $state2) = @_;
-
- $self->_decr_alphabet( $self->{TRANS}[$state1][$state2] );
- $self->{TRANS}[$state1][$state2] = undef;
-}
-
-# given a state and a symbol, it tells you
-# what the next state(s) are; do get successors
-# for find the successors for a set of symbols,
-# use array refs. For example:
-# @NEXT=$self->successors([@nodes],[@symbols]);
-sub successors {
- my ($self, $state, $symb) = @_;
-
- my @states = ref $state eq 'ARRAY' ? @$state : ($state);
- my @symbs = defined $symb
- ? (ref $symb eq 'ARRAY' ? @$symb : ($symb))
- : ();
-
- $self->_assert_states(@states);
-
- my %succ;
- for my $s (@states) {
- $succ{$_}++
- for grep { my $t = $self->{TRANS}[$s][$_];
- defined $t && (@symbs ? $t->does(@symbs) : 1) } $self->get_states;
- }
-
- return keys %succ;
-}
-
-sub predecessors {
- my $self = shift;
- $self->clone->reverse->successors(@_);
-}
-
-# reverse - no change from NFA
-sub reverse {
- my $self = $_[0]->clone;
- $self->_transpose;
-
- my @start = $self->get_starting;
- my @final = $self->get_accepting;
-
- $self->unset_accepting( $self->get_states );
- $self->unset_starting( $self->get_states );
-
- $self->set_accepting( @start );
- $self->set_starting( @final );
-
- $self;
-}
-
-# get an array of all symbols
-sub alphabet {
- my $self = shift;
- grep length, keys %{ $self->{ALPHA} };
-}
-
-# give an array of symbols, return the symbols that
-# are in the alphabet
-#sub is_in_alphabet {
-# my $self = shift;
-# my $
-#}
-
-############
-sub prune {
- my $self = shift;
-
- my @queue = $self->get_starting;
- my %seen = map { $_ => 1 } @queue;
-
- while (@queue) {
- @queue = grep { ! $seen{$_}++ } $self->successors(\@queue);
- }
-
- my @useless = grep { !$seen{$_} } $self->get_states;
- $self->delete_states(@useless);
-
- return @useless;
-}
-
-
-############
-
-use Storable 'dclone';
-sub clone {
- dclone( $_[0] );
-}
-
-sub _transpose {
- my $self = shift;
- my $N = $self->num_states - 1;
-
- $self->{TRANS} = [
- map {
- my $row = $_;
- [ map { $_->[$row] } @{$self->{TRANS}} ]
- } 0 .. $N
- ];
-}
-
-# tests to see if set1 is a subset of set2
-sub array_is_subset {
- my $self = shift;
- my $set1 = shift;
- my $set2 = shift;
- my $ok = 1;
- my %setcount = ();
- foreach ($self->array_unique(@{$set1}),$self->array_unique(@{$set2})) {
- $setcount{$_}++;
- }
- foreach ($self->array_unique(@{$set1})) {
- if ($setcount{$_} != 2) {
- $ok = 0;
- last;
- }
- }
- return $ok;
-}
-
-sub array_unique {
- my $self = shift;
- my %ret = ();
- foreach (@_) {
- $ret{$_}++;
- }
- return keys(%ret);
-}
-
-sub array_complement {
- my $self = shift;
- my $set1 = shift;
- my $set2 = shift;
- my @ret = ();
- # convert set1 to a hash
- my %set1hash = map {$_ => 1} @{$set1};
- # iterate of set2 and test if $set1
- foreach (@{$set2}) {
- if (!defined $set1hash{$_}) {
- push(@ret,$_);
- }
- }
- ## Now do the same using $set2
- # convert set2 to a hash
- my %set2hash = map {$_ => 1} @{$set2};
- # iterate of set1 and test if $set1
- foreach (@{$set1}) {
- if (!defined $set2hash{$_}) {
- push(@ret,$_);
- }
- }
- # now @ret contains all items in $set1 not in $set 2 and all
- # items in $set2 not in $set1
- return @ret;
-}
-
-# returns all items that 2 arrays have in common
-sub array_intersect {
- my $self = shift;
- my $set1 = shift;
- my $set2 = shift;
- my %setcount = ();
- my @ret = ();
- foreach ($self->array_unique(@{$set1})) {
- $setcount{$_}++;
- }
- foreach ($self->array_unique(@{$set2})) {
- $setcount{$_}++;
- push(@ret,$_) if ($setcount{$_} > 1);
- }
- return @ret;
-}
-
-# given a set of symbols, returns only the valid ones
-sub get_valid_symbols {
- my $self = shift;
- my $symbols = shift;
- return $self->array_intersect([$self->alphabet()],[@{$symbols}])
-}
-
-## add an FA's states & transitions to this FA (as disjoint union)
-sub _swallow {
- my ($self, $other) = @_;
- my $N1 = $self->num_states;
- my $N2 = $other->num_states;
-
- push @$_, (undef) x $N2
- for @{ $self->{TRANS} };
-
- push @{ $self->{TRANS} }, [ (undef) x $N1, @{ clone $_ } ]
- for @{ $other->{TRANS} };
-
- push @{ $self->{STATES} }, @{ clone $other->{STATES} };
-
- $self->{ALPHA}{$_} += $other->{ALPHA}{$_}
- for keys %{ $other->{ALPHA} };
-
- return map { $_ + $N1 } $other->get_states;
-}
-
-1;
-
-__END__
-
-
-=head2 Manipulation & Inspection Of States
-
-=over
-
-=item $fa-E<gt>get_states
-
-Returns a list of all the state "names" in $fa.
-
-=item $fa-E<gt>num_states
-
-Returns the number of states in $fa.
-
-=item $fa-E<gt>is_state($state_id)
-
-Returns a boolean indicating whether $state_id is a recognized state "name."
-
-=item $fa-E<gt>delete_states(@states)
-
-Deletes the states given in @states and their corresponding transitions. The
-remaining states in the FA may be "renamed" (renumbered)! Return value not
-used.
-
-=item $fa-E<gt>add_states($num)
-
-Adds $num states to $fa, and returns a list of the new state "names."
-
-=item $fa-E<gt>get_starting
-
-=item $fa-E<gt>get_accepting
-
-Returns a list of all the states which are labeled as starting/accepting,
-respectively.
-
-=item $fa-E<gt>set_accepting(@states)
-
-=item $fa-E<gt>unset_accepting(@states)
-
-=item $fa-E<gt>set_starting(@states)
-
-=item $fa-E<gt>unset_starting(@states)
-
-Sets/unsets a list of states as being labeled starting/accepting,
-respectively.
-
-=item $fa-E<gt>is_starting($state)
-
-=item $fa-E<gt>is_accepting($state)
-
-Returns a boolean indicating whether $state is labeled as starting/accepting,
-respectively.
-
-=item $fa-E<gt>prune
-
-Deletes the states which are not reachable (via zero or more transitions)
-from starting states. Returns a list of the "names" of states that were
-deleted.
-
-=back
-
-=head2 Manipulation & Inspection Of Transitions
-
-Each transition between states is a transition object, which knows how
-to organize several "labels." Think of this as the mechanism by which
-multiple arrows in the state diagram between the same states are collapsed
-to a single arrow. This interface is abstracted away into the following
-public methods:
-
-=over
-
-=item $fa-E<gt>set_transition($state1, $state2, @labels)
-
-Resets the transition between $state1 and $state2 to a transition
-initialized using data @labels. If @labels is omitted or contains
-only undefined elements, then the call is equivalent to C<remove_transition>.
-
-=item $fa-E<gt>add_transition($state1, $state2, @labels)
-
-Adds @labels to the transition between $state1 and $state2.
-
-=item $fa-E<gt>get_transition($state1, $state2)
-
-Returns the transition object stored between $state1 and $state2, or
-undef if there is no transition.
-
-=item $fa-E<gt>remove_transition($state1, $state2)
-
-Removes the transition object between $state1 and $state2.
-
-=item $fa-E<gt>successors(\@states)
-
-=item $fa-E<gt>successors($state)
-
-=item $fa-E<gt>successors(\@states, $label)
-
-=item $fa-E<gt>successors($state, $label)
-
-=item $fa-E<gt>successors(\@states, \@labels)
-
-=item $fa-E<gt>successors($state, \@labels)
-
-Given a state/set of states, and one or more labels, returns a list of
-the states (without duplicates) reachable from the states via a single
-transition having any of the given labels. If no labels are given, returns
-the states reachable by any (single) transition.
-
-Note that this method makes no distinction for epsilon transitions, these
-are only special in FLAT::NFA objects.
-
-=item $fa-E<gt>alphabet
-
-Returns the list of characters (without duplicates) used among all
-transition labels in the automaton.
-
-=back
-
-=head2 Conversions To External Formats
-
-=over
-
-=item $fa-E<gt>as_graphviz
-
-Returns a string containing a GraphViz (dot) description of the automaton,
-suitable for rendering with your favorite GraphViz layout engine.
-
-=item $fa-E<gt>as_summary
-
-Returns a string containing a plaintext description of the automaton,
-suitable for debugging purposes.
-
-=back
-
-=head2 Miscellaneous
-
-=over
-
-=item $fa-E<gt>clone
-
-Returns an identical copy of $fa.
-
-=back
-
-=head1 AUTHORS & ACKNOWLEDGEMENTS
-
-FLAT is written by Mike Rosulek E<lt>mike at mikero dot comE<gt> and
-Brett Estrade E<lt>estradb at gmail dot comE<gt>.
-
-The initial version (FLAT::Legacy) by Brett Estrade was work towards an
-MS thesis at the University of Southern Mississippi.
-
-Please visit the Wiki at http://www.0x743.com/flat
-
-=head1 LICENSE
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself.
diff --git a/lib/FLAT/NFA.pm b/lib/FLAT/NFA.pm
deleted file mode 100644
index 344ea76..0000000
--- a/lib/FLAT/NFA.pm
+++ /dev/null
@@ -1,509 +0,0 @@
-package FLAT::NFA;
-
-use strict;
-use base 'FLAT::FA';
-
-use FLAT::Transition;
-
-=head1 NAME
-
-FLAT::NFA - Nondeterministic finite automata
-
-=head1 SYNOPSIS
-
-A FLAT::NFA object is a finite automata whose transitions are labeled
-either with characters or the empty string (epsilon).
-
-=cut
-
-sub new {
- my $pkg = shift;
- my $self = $pkg->SUPER::new(@_);
- $self->{TRANS_CLASS} = "FLAT::Transition";
- return $self;
-}
-
-sub singleton {
- my ($class, $char) = @_;
- my $nfa = $class->new;
-
- if (not defined $char) {
- $nfa->add_states(1);
- $nfa->set_starting(0);
- } elsif ($char eq "") {
- $nfa->add_states(1);
- $nfa->set_starting(0);
- $nfa->set_accepting(0);
- } else {
- $nfa->add_states(2);
- $nfa->set_starting(0);
- $nfa->set_accepting(1);
- $nfa->set_transition(0, 1, $char);
- }
- return $nfa;
-}
-
-sub as_nfa { $_[0]->clone }
-
-sub union {
- my @nfas = map { $_->as_nfa } @_;
- my $result = $nfas[0]->clone;
- $result->_swallow($_) for @nfas[1 .. $#nfas];
- $result;
-}
-
-sub concat {
- my @nfas = map { $_->as_nfa } @_;
-
- my $result = $nfas[0]->clone;
- my @newstate = ([ $result->get_states ]);
- my @start = $result->get_starting;
-
- for (1 .. $#nfas) {
- push @newstate, [ $result->_swallow( $nfas[$_] ) ];
- }
-
- $result->unset_accepting($result->get_states);
- $result->unset_starting($result->get_states);
- $result->set_starting(@start);
-
- for my $nfa_id (1 .. $#nfas) {
- for my $s1 ($nfas[$nfa_id-1]->get_accepting) {
- for my $s2 ($nfas[$nfa_id]->get_starting) {
- $result->set_transition(
- $newstate[$nfa_id-1][$s1],
- $newstate[$nfa_id][$s2], "" );
- }}
- }
-
- $result->set_accepting(
- @{$newstate[-1]}[ $nfas[-1]->get_accepting ] );
-
- $result;
-}
-
-sub kleene {
- my $result = $_[0]->clone;
-
- my ($newstart, $newfinal) = $result->add_states(2);
-
- $result->set_transition($newstart, $_, "")
- for $result->get_starting;
- $result->unset_starting( $result->get_starting );
- $result->set_starting($newstart);
-
- $result->set_transition($_, $newfinal, "")
- for $result->get_accepting;
- $result->unset_accepting( $result->get_accepting );
- $result->set_accepting($newfinal);
-
- $result->set_transition($newstart, $newfinal, "");
- $result->set_transition($newfinal, $newstart, "");
-
- $result;
-}
-
-sub reverse {
- my $self = $_[0]->clone;
- $self->_transpose;
-
- my @start = $self->get_starting;
- my @final = $self->get_accepting;
-
- $self->unset_accepting( $self->get_states );
- $self->unset_starting( $self->get_states );
-
- $self->set_accepting( @start );
- $self->set_starting( @final );
-
- $self;
-}
-
-###########
-
-sub is_empty {
- my $self = shift;
-
- my @queue = $self->get_starting;
- my %seen = map { $_ => 1 } @queue;
-
- while (@queue) {
- return 0 if grep { $self->is_accepting($_) } @queue;
- @queue = grep { !$seen{$_}++ } $self->successors(\@queue);
- }
- return 1;
-}
-
-sub is_finite {
- my $self = shift;
-
- my @alphabet = $self->alphabet;
- return 1 if @alphabet == 0;
-
- my @queue = $self->get_starting;
- my %seen = map { $_ => 1 } @queue;
-
- while (@queue) {
- @queue = grep { !$seen{$_}++ } $self->successors(\@queue);
- }
-
- for my $s ( grep { $self->is_accepting($_) } keys %seen ) {
- @queue = $self->epsilon_closure($s);
- %seen = map { $_ => 1 } @queue;
-
- while (@queue) {
- my @next = $self->epsilon_closure(
- $self->successors(\@queue, \@alphabet) );
-
- return 0 if grep { $s eq $_ } @next;
- @queue = grep { !$seen{$_}++ } @next;
- }
- }
- return 1;
-}
-
-sub epsilon_closure {
- my ($self, @states) = @_;
- my %seen = map { $_ => 1 } @states;
- my @queue = @states;
-
- while (@queue) {
- @queue = grep { ! $seen{$_}++ } $self->successors( \@queue, "" );
- }
-
- keys %seen;
-}
-
-
-sub contains {
- my ($self, $string) = @_;
-
- my @active = $self->epsilon_closure( $self->get_starting );
- for my $char (split //, $string) {
- return 0 if ! @active;
- @active = $self->epsilon_closure( $self->successors(\@active, $char) );
- }
- return !! grep { $self->is_accepting($_) } @active;
-}
-
-sub trace {
- my ($self, $string) = @_;
-
- my @trace = ([ $self->epsilon_closure( $self->get_starting ) ]);
-
- for my $char (split //, $string) {
- push @trace,
- [ $self->epsilon_closure( $self->successors($trace[-1], $char) ) ];
- }
- return @trace;
-}
-############
-
-sub _extend_alphabet {
- my ($self, @alpha) = @_;
-
- my %alpha = map { $_ => 1 } @alpha;
- delete $alpha{$_} for $self->alphabet;
-
- return if not keys %alpha;
-
- my $trash = $self->add_states(1);
- for my $state ($self->get_states) {
- next if $state eq $trash;
- for my $char (keys %alpha) {
- $self->add_transition($state, $trash, $char);
- }
- }
- $self->add_transition($trash, $trash, $self->alphabet);
-}
-
-######## transformations
-
-# subset construction
-sub as_dfa {
- my $self = shift;
-
- my $result = FLAT::DFA->new;
- my %subset;
-
- my %final = map { $_ => 1 } $self->get_accepting;
- my @start = sort { $a <=> $b } $self->epsilon_closure( $self->get_starting );
-
- my $start = $subset{ _SET_ID(@start) } = $result->add_states(1);
- $result->set_starting($start);
-
- $result->set_accepting( $start )
- if grep $_, @final{@start};
-
- my @queue = (\@start);
- while (@queue) {
- my @states = @{ shift @queue };
- my $S = $subset{ _SET_ID(@states) };
-
- for my $symb ($self->alphabet) {
- my @to = $self->epsilon_closure(
- $self->successors(\@states, $symb) );
-
- if ( not exists $subset{_SET_ID(@to)} ) {
- push @queue, \@to;
- my $T = $subset{_SET_ID(@to)} = $result->add_states(1);
- $result->set_accepting($T)
- if grep $_, @final{@to};
- }
-
- $result->add_transition($S, $subset{ _SET_ID(@to) }, $symb);
- }
- }
-
- $result;
-}
-
-############ Formatted output
-
-# Format that Dr. Sukhamay KUNDU likes to use in his assignments :)
-# This format is just a undirected graph - so transition and state info is lost
-
-sub as_undirected {
- my $self = shift;
- my @symbols = $self->alphabet();
- my @states = $self->get_states();
- my %edges = ();
- foreach (@states) {
- my $s = $_;
- foreach (@symbols) {
- my $a = $_;
- # foreach state, get all nodes connected to it; ignore symbols and
- # treat transitions simply as directed
- push(@{$edges{$s}},$self->successors($s,$a));
- foreach ($self->successors($s,$a)) {
- push(@{$edges{$_}},$s);
- }
- }
- }
- my @lines = (($#states+1));
- foreach (sort{$a <=> $b;}(keys(%edges))) { #<-- iterate over numerically sorted list of keys
- @{$edges{$_}} = sort {$a <=> $b;} $self->array_unique(@{$edges{$_}}); #<- make items unique and sort numerically
- push(@lines,sprintf("%s(%s):%s",$_,($#{$edges{$_}}+1),join(' ',@{$edges{$_}})));
- }
- return join("\n",@lines);
- }
-
-# Format that Dr. Sukhamay KUNDU likes to use in his assignments :)
-# This format is just a directed graph - so transition and state info is lost
-
-sub as_digraph {
- my $self = shift;
- my @symbols = $self->alphabet();
- my @states = $self->get_states();
- my @lines = ();
- foreach (@states) {
- my $s = $_;
- my @edges = ();
- foreach (@symbols) {
- my $a = $_;
- # foreach state, get all nodes connected to it; ignore symbols and
- # treat transitions simply as directed
- push(@edges,$self->successors($s,$a));
- }
- @edges = sort {$a <=> $b;} $self->array_unique(@edges); #<- make items unique and sort numerically
- push(@lines,sprintf("%s(%s): %s",$s,($#edges+1),join(' ',@edges)));
- }
- return sprintf("%s\n%s",($#states+1),join("\n",@lines));
-}
-
-
-# Graph Description Language, aiSee, etc
-sub as_gdl {
- my $self = shift;
-
- my @states = map {
- sprintf qq{node: { title:"%s" shape:circle borderstyle: %s}\n},
- $_,
- ($self->is_accepting($_) ? "double bordercolor: red" : "solid")
- } $self->get_states;
-
- my @trans;
- for my $s1 ($self->get_states) {
- for my $s2 ($self->get_states) {
- my $t = $self->get_transition($s1, $s2);
-
- if (defined $t) {
- push @trans, sprintf qq[edge: { source: "%s" target: "%s" label: "%s" arrowstyle: line }\n],
- $s1, $s2, $t->as_string;
- }
- }}
-
- return sprintf "graph: {\ndisplay_edge_labels: yes\n\n%s\n%s}\n",
- join("", @states),
- join("", @trans);
-}
-
-# Graphviz: dot, etc
-## digraph, directed
-sub as_graphviz {
- my $self = shift;
-
- my @states = map {
- sprintf qq{%s [label="%s",shape=%s]\n},
- $_,
- ($self->is_starting($_) ? "start ($_)" : "$_"),
- ($self->is_accepting($_) ? "doublecircle" : "circle")
- } $self->get_states;
-
- my @trans;
- for my $s1 ($self->get_states) {
- for my $s2 ($self->get_states) {
- my $t = $self->get_transition($s1, $s2);
-
- if (defined $t) {
- push @trans, sprintf qq[%s -> %s [label="%s"]\n],
- $s1, $s2, $t->as_string;
- }
- }}
-
- return sprintf "digraph G {\ngraph [rankdir=LR]\n\n%s\n%s}\n",
- join("", @states),
- join("", @trans);
-}
-## undirected
-sub as_undirected_graphviz {
- my $self = shift;
-
- my @states = map {
- sprintf qq{%s [label="%s",shape=%s]\n},
- $_,
- ("$_"),
- ("circle")
- } $self->get_states;
-
- my @trans;
- for my $s1 ($self->get_states) {
- for my $s2 ($self->get_states) {
- my $t = $self->get_transition($s1, $s2);
-
- if (defined $t) {
- push @trans, sprintf qq[%s -- %s\n],
- $s1, $s2, $t->as_string;
- }
- }}
-
- return sprintf "graph G {\ngraph [rankdir=LR]\n\n%s\n%s}\n",
- join("", @states),
- join("", @trans);
-}
-
-sub _SET_ID { return join "\0", sort { $a <=> $b } @_; }
-
-sub as_summary {
- my $self = shift;
- my $out = '';
- $out .= sprintf ("States : ");
- my @start;
- my @final;
- foreach ($self->get_states()) {
- $out .= sprintf "'$_' ";
- if ($self->is_starting($_)) {
- push(@start,$_);
- }
- if ($self->is_accepting($_)) {
- push(@final,$_);
- }
- }
- $out .= sprintf ("\nStart State : '%s'\n",join('',@start));
- $out .= sprintf ("Final State(s) : ");
- foreach (@final) {
- $out .= sprintf "'$_' ";
- }
- $out .= sprintf ("\nAlphabet : ");
- foreach ($self->alphabet()) {
- $out .= sprintf "'$_' ";
- }
- $out .= sprintf ("\nTransitions :\n");
- my @trans;
- for my $s1 ($self->get_states) {
- for my $s2 ($self->get_states) {
- my $t = $self->get_transition($s1, $s2);
- if (defined $t) {
- push @trans, sprintf qq[%s -> %s on "%s"\n],
- $s1, $s2, $t->as_string;
- }
- }}
- $out .= join('',@trans);
- return $out;
-}
-
-1;
-
-__END__
-
-=head1 USAGE
-
-In addition to implementing the interface specified in L<FLAT>, FLAT::NFA
-objects provide the following NFA-specific methods:
-
-=over
-
-=item $nfa-E<gt>epsilon_closure(@states)
-
-Returns the set of states (without duplicates) which are reachable from
-@states via zero or more epsilon-labeled transitions.
-
-=item $nfa-E<gt>trace($string)
-
-Returns a list of N+1 arrayrefs, where N is the length of $string. The
-I-th arrayref contains the states which are reachable from the starting
-state(s) of $nfa after reading I characters of $string. Correctly accounts
-for epsilon transitions.
-
-=item $nfa-E<gt>as_undirected
-
-Outputs FA in a format that may be easily read into an external program as
-a description of an undirected graph.
-
-=item $nfa-E<gt>as_digraph
-
-Outputs FA in a format that may be easily read into an external program as
-a description of an directed graph.
-
-=item $nfa-E<gt>as_gdl
-
-Outputs FA in Graph Description Language (GDL), including directed transitions
-with symbols and state names labeled.
-
-=item $nfa-E<gt>as_graphviz
-
-Outputs FA in Graphviz format, including directed transitions with symbols and
-and state names labeled. This output may be directly piped into any of the
-Graphviz layout programs, and in turn one may output an image using a single
-commandline instruction. C<fash> uses this function to implement its "nfa2gv"
-command:
-
- fash nfa2gv "a*b" | dot -Tpng > nfa.png
-
-=item $nfa-E<gt>as_undirected_graphviz
-
-Outputs FA in Graphviz format, with out the directed transitions or labels.
-The output is suitable for any of the Graphvize layout programs, as discussed
-above.
-
-=item $nfa-E<gt>as_summary
-
-Outputs a summary of the FA, including its states, symbols, and transition matrix.
-It is useful for manually validating what the FA looks like.
-
-=back
-
-=head1 AUTHORS & ACKNOWLEDGEMENTS
-
-FLAT is written by Mike Rosulek E<lt>mike at mikero dot comE<gt> and
-Brett Estrade E<lt>estradb at gmail dot comE<gt>.
-
-The initial version (FLAT::Legacy) by Brett Estrade was work towards an
-MS thesis at the University of Southern Mississippi.
-
-Please visit the Wiki at http://www.0x743.com/flat
-
-=head1 LICENSE
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself.
diff --git a/lib/FLAT/PFA.pm b/lib/FLAT/PFA.pm
deleted file mode 100644
index 5557525..0000000
--- a/lib/FLAT/PFA.pm
+++ /dev/null
@@ -1,293 +0,0 @@
-package FLAT::PFA;
-use strict;
-use base 'FLAT::NFA';
-use Carp;
-
-use FLAT::Transition;
-
-use constant LAMBDA => '#lambda';
-
-# Note: in a PFA, states are made up of active nodes. In this implementation, we have
-# decided to retain the functionality of the state functions in FA.pm, although the entities
-# being manipulated are technically nodes, not states. States are only explicitly tracked
-# once the PFA is serialized into an NFA. Therefore, the TRANS member of the PFA object is
-# the nodal transition function, gamma. The state transition function, delta, is not used
-# in anyway, but is derived out of the PFA->NFA conversion process.
-
-
-# The new way of doing things eliminated from PFA.pm of FLAT::Legacy is the
-# need to explicitly track: start nodes, final nodes, symbols, and lambda & epsilon symbols,
-
-sub new {
- my $pkg = shift;
- my $self = $pkg->SUPER::new(@_); # <-- SUPER is FLAT::NFA
- return $self;
-}
-
-# Singleton is no different than the NFA singleton
-sub singleton {
- my ($class, $char) = @_;
- my $pfa = $class->new;
- if (not defined $char) {
- $pfa->add_states(1);
- $pfa->set_starting(0);
- } elsif ($char eq "") {
- $pfa->add_states(1);
- $pfa->set_starting(0);
- $pfa->set_accepting(0);
- } else {
- $pfa->add_states(2);
- $pfa->set_starting(0);
- $pfa->set_accepting(1);
- $pfa->set_transition(0, 1, $char);
- }
- return $pfa;
-}
-
-# attack of the clones
-sub as_pfa { $_[0]->clone() }
-
-sub set_starting {
- my ($self, @states) = @_;
- $self->_assert_states(@states);
- $self->{STATES}[$_]{starting} = 1 for @states;
-}
-
-# Creates a single start state with epsilon transitions from
-# the former start states;
-# Creates a single final state with epsilon transitions from
-# the former accepting states
-sub pinch {
- my $self = shift;
- my $symbol = shift;
- my @starting = $self->get_starting;
- if (@starting > 1) {
- my $newstart = $self->add_states(1);
- map {$self->add_transition($newstart,$_,$symbol)} @starting;
- $self->unset_starting(@starting);
- $self->set_starting($newstart);
- }
- #
- my @accepting = $self->get_accepting;
- if (@accepting > 1) {
- my $newfinal = $self->add_states(1);
- map {$self->add_transition($_,$newfinal,$symbol)} @accepting;
- $self->unset_accepting(@accepting);
- $self->set_accepting($newfinal);
- }
- return;
-}
-
-# Implement the joining of two PFAs with lambda transitions
-# Note: using epsilon pinches for simplicity
-sub shuffle {
- my @pfas = map { $_->as_pfa } @_;
- my $result = $pfas[0]->clone;
- $result->_swallow($_) for @pfas[1 .. $#pfas];
- $result->pinch(LAMBDA);
- $result;
-}
-
-##############
-
-sub is_tied {
- my ($self, $state) = @_;
- $self->_assert_states($state);
- return $self->{STATES}[$state]{tied};
-}
-
-sub set_tied {
- my ($self, @states) = @_;
- $self->_assert_states(@states);
- $self->{STATES}[$_]{tied} = 1 for @states;
-}
-
-sub unset_tied {
- my ($self, @states) = @_;
- $self->_assert_states(@states);
- $self->{STATES}[$_]{tied} = 0 for @states;
-}
-
-sub get_tied {
- my $self = shift;
- return grep { $self->is_tied($_) } $self->get_states;
-}
-
-##############
-
-# joins two PFAs in a union (or) - no change from NFA
-sub union {
- my @pfas = map { $_->as_pfa } @_;
- my $result = $pfas[0]->clone;
- $result->_swallow($_) for @pfas[1 .. $#pfas];
- $result->pinch('');
- $result;
-}
-
-# joins two PFAs via concatenation - no change from NFA
-sub concat {
- my @pfas = map { $_->as_pfa } @_;
-
- my $result = $pfas[0]->clone;
- my @newstate = ([ $result->get_states ]);
- my @start = $result->get_starting;
-
- for (1 .. $#pfas) {
- push @newstate, [ $result->_swallow( $pfas[$_] ) ];
- }
-
- $result->unset_accepting($result->get_states);
- $result->unset_starting($result->get_states);
- $result->set_starting(@start);
-
- for my $pfa_id (1 .. $#pfas) {
- for my $s1 ($pfas[$pfa_id-1]->get_accepting) {
- for my $s2 ($pfas[$pfa_id]->get_starting) {
- $result->set_transition(
- $newstate[$pfa_id-1][$s1],
- $newstate[$pfa_id][$s2], "" );
- }}
- }
-
- $result->set_accepting(
- @{$newstate[-1]}[ $pfas[-1]->get_accepting ] );
-
- $result;
-}
-
-# forms closure around a the given PFA - no change from NFA
-sub kleene {
- my $result = $_[0]->clone;
-
- my ($newstart, $newfinal) = $result->add_states(2);
-
- $result->set_transition($newstart, $_, "")
- for $result->get_starting;
- $result->unset_starting( $result->get_starting );
- $result->set_starting($newstart);
-
- $result->set_transition($_, $newfinal, "")
- for $result->get_accepting;
- $result->unset_accepting( $result->get_accepting );
- $result->set_accepting($newfinal);
-
- $result->set_transition($newstart, $newfinal, "");
- $result->set_transition($newfinal, $newstart, "");
-
- $result;
-}
-
-sub as_nfa {
- my $self = shift;
- my $result = FLAT::NFA->new();
- # Dstates is initially populated with the start state, which
- # is exactly the set of all nodes marked as a starting node
- my @Dstates = [sort($self->get_starting())]; # I suppose all start states are considered 'tied'
- my %DONE = (); # |- what about all accepting states? I think so...
- # the main while loop that ends when @Dstates becomes exhausted
- my %NEW = ();
- while (@Dstates) {
- my $current = pop(@Dstates);
- my $currentid = join(',',@{$current});
- $DONE{$currentid}++; # mark done
- foreach my $symbol ($self->alphabet(),'') { # Sigma UNION epsilon
- if (LAMBDA eq $symbol) {
- my @NEXT = ();
- my @tmp = $self->successors([@{$current}],$symbol);
- if (@tmp) {
- my @pred = $self->predecessors([@tmp],LAMBDA);
- if ($self->array_is_subset([@pred],[@{$current}])) {
- push(@NEXT,@tmp,$self->array_complement([@{$current}],[@pred]));
- @NEXT = sort($self->array_unique(@NEXT));
- my $nextid = join(',',@NEXT);
- push(@Dstates,[@NEXT]) if (!exists($DONE{$nextid}));
- # make new states if none exist and track
- if (!exists($NEW{$currentid})) {$NEW{$currentid} = $result->add_states(1)};
- if (!exists($NEW{$nextid})) {$NEW{$nextid} = $result->add_states(1) };
- $result->add_transition($NEW{$currentid},$NEW{$nextid},'');
- }
- }
- } else {
- foreach my $node (@{$current}) {
- my @tmp = $self->successors([$node],$symbol);
- foreach my $new (@tmp) {
- my @NEXT = ();
- push(@NEXT,$new,$self->array_complement([@{$current}],[$node]));
- @NEXT = sort($self->array_unique(@NEXT));
- my $nextid = join(',',@NEXT);
- push(@Dstates,[@NEXT]) if (!exists($DONE{$nextid}));
- # make new states if none exist and track
- if (!exists($NEW{$currentid})) {$NEW{$currentid} = $result->add_states(1)};
- if (!exists($NEW{$nextid})) {$NEW{$nextid} = $result->add_states(1) };
- $result->add_transition($NEW{$currentid},$NEW{$nextid},$symbol);
- }
- }
- }
- }
- }
- $result->set_starting($NEW{join(",",sort $self->get_starting())});
- $result->set_accepting($NEW{join(",",sort $self->get_accepting())});
- return $result;
- }
-
-1;
-
-__END__
-
-=head1 NAME
-
-FLAT::PFA - Parallel finite automata
-
-=head1 SYNOPSIS
-
-A FLAT::PFA object is a finite automata whose transitions are labeled either
-with characters, the empty string (epsilon), or a concurrent line of execution
-(lambda). It essentially models two FSA in a non-deterministic way such that
-a string is valid it puts the FSA of the shuffled languages both into a final,
-or accepting, state. A PFA is an NFA, and as such exactly describes a regular
-language.
-
-A PFA contains nodes and states. A state is made up of whatever nodes happen
-to be active. There are two transition functions, nodal transitions and state
-transitions. When a PFA is converted into a NFA, there is no longer a need for
-nodes or nodal transitions, so they go are eliminated. PFA model state spaces
-much more compactly than NFA, and an N state PFA may represent 2**N non-deterministic
-states. This also means that a PFA may represent up to 2^(2^N) deterministic states.
-
-=head1 USAGE
-
-(not implemented yet)
-
-In addition to implementing the interface specified in L<FLAT> and L<FLAT::NFA>,
-FLAT::PFA objects provide the following PFA-specific methods:
-
-=over
-
-=item $pfa-E<gt>shuffle
-
-Shuffle construct for building a PFA out of a PRE (i.e., a regular expression with
-the shuffle operator)
-
-=item $pfa-E<gt>as_nfa
-
-Converts a PFA to an NFA by enumerating all states; similar to the Subset Construction
-Algorithm, it does not implement e-closure. Instead it treats epsilon transitions
-normally, and joins any states resulting from a lambda (concurrent) transition
-using an epsilon transition.
-
-=back
-
-=head1 AUTHORS & ACKNOWLEDGEMENTS
-
-FLAT is written by Mike Rosulek E<lt>mike at mikero dot comE<gt> and
-Brett Estrade E<lt>estradb at gmail dot comE<gt>.
-
-The initial version (FLAT::Legacy) by Brett Estrade was work towards an
-MS thesis at the University of Southern Mississippi.
-
-Please visit the Wiki at http://www.0x743.com/flat
-
-=head1 LICENSE
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself.
diff --git a/lib/FLAT/Regex.pm b/lib/FLAT/Regex.pm
deleted file mode 100644
index 2c5c243..0000000
--- a/lib/FLAT/Regex.pm
+++ /dev/null
@@ -1,194 +0,0 @@
-package FLAT::Regex;
-use base 'FLAT';
-use strict;
-use Carp;
-
-use FLAT::Regex::Parser;
-use FLAT::Regex::Op;
-
-my $PARSER = FLAT::Regex::Parser->new(qw[ alt concat star ]);
-#### TODO: error checking in the parse
-
-sub _parser { $PARSER }
-
-sub new {
- my ($pkg, $string) = @_;
- my $result = $pkg->_parser->parse($string)
- or croak qq[``$string'' is not a valid regular expression];
-
- $pkg->_from_op( $result );
-}
-
-sub _from_op {
- my ($proto, $op) = @_;
- $proto = ref $proto || $proto; ## I really do want this
-
- bless [ $op ], $proto;
-}
-
-sub op {
- $_[0][0];
-}
-
-use overload '""' => 'as_string';
-sub as_string {
- $_[0]->op->as_string(0);
-}
-
-sub as_perl_regex {
- my ($self, %opts) = @_;
-
- my $fmt = $opts{anchored} ? '(?:\A%s\z)' : '(?:%s)';
- return sprintf $fmt, $self->op->as_perl_regex(0);
-}
-
-sub contains {
- my ($self, $string) = @_;
- $string =~ $self->as_perl_regex(anchored => 1);
-}
-
-sub as_nfa {
- $_[0]->op->as_nfa;
-}
-
-sub as_pfa {
- $_[0]->op->as_pfa;
-}
-
-#### regular language standard interface implementation:
-#### TODO: parameter checking?
-
-sub as_regex {
- $_[0];
-}
-
-sub union {
- my $self = $_[0];
- my $op = FLAT::Regex::op::alt->new( map { $_->as_regex->op } @_ );
- $self->_from_op($op);
-}
-
-sub intersect {
- my @dfas = map { $_->as_dfa } @_;
- my $self = shift @dfas;
- $self->intersect(@dfas)->as_regex;
-}
-
-sub complement {
- my $self = shift;
- $self->as_dfa->complement->as_regex;
-}
-
-sub concat {
- my $self = $_[0];
- my $op = FLAT::Regex::op::concat->new( map { $_->as_regex->op } @_ );
- $self->_from_op($op);
-}
-
-sub kleene {
- my $self = shift;
- my $op = FLAT::Regex::op::star->new( $self->op );
- $self->_from_op($op);
-}
-
-sub reverse {
- my $self = shift;
- my $op = $self->op->reverse;
- $self->_from_op($op);
-}
-
-sub is_empty {
- $_[0]->op->is_empty;
-}
-
-sub is_finite {
- $_[0]->op->is_finite;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-FLAT::Regex - Regular expressions
-
-=head1 SYNOPSIS
-
-A FLAT::Regex object is a regular expression.
-
-=head1 USAGE
-
-In addition to implementing the interface specified in L<FLAT>, FLAT::Regex
-objects provide the following regex-specific methods:
-
-=over
-
-=item FLAT::Regex-E<gt>new($string)
-
-Returns a regex object representing the expression given in $string. C<|>
-and C<+> can both be used to denote alternation. C<*> denotes Kleene star, and
-parentheses can be used for grouping. No other features or shortcut notation
-is currently supported (character classes, {n,m} repetition, etc).
-
-Whitespaces is ignored. To specify a literal space, use C<[ ]>. This syntax
-can also be used to specify atomic "characters" longer than a single
-character. For example, the expression:
-
- [foo]abc[bar]*
-
-is treated as a regular expression over the symbols "a", "b", "c", "foo",
-and "bar". In particular, this means that when the regular expression is
-reversed, "foo" and "bar" remain the same (i.e, they do not become "oof" and
-"rab").
-
-The empty regular expression (epsilon) is written as C<[]>, and the null
-regular expression (sometimes called phi) is specified with the C<#>
-character. To specify a literal hash-character, use C<[#]>. Including
-literal square bracket characters is currently not supported.
-
-The expression "" (or any string containing only whitespace) is not a valid
-FLAT regex expression. Either C<[]> or C<#> are probably what was intended.
-
-=item $regex-E<gt>as_string
-
-Returns the string representation of the regex, in the same format as above.
-It is NOT necessarily true that
-
- FLAT::Regex->new($string)->as_string
-
-is identical to $string, especially if $string contains whitespace or
-redundant parentheses.
-
-=item $regex-E<gt>as_perl_regex
-
-=item $regex-E<gt>as_perl_regex(anchored => $bool);
-
-Returns an equivalent Perl regular expression. If the "anchored" option
-is set to a true value, the regular expression will be anchored with
-C<\A> and C<\z>. The default behavior is to omit the anchors.
-
-The Perl regex will not contain capturing parentheses. "Extended" characters
-that are written as "[char]" in FLAT regexes will be written without the
-square brackets in the corresponding Perl regex. So the following:
-
- FLAT::Regex->new("[foo][bar]*")->as_perl_regex
-
-will be equal to "(?:foo(?:bar)*)".
-
-=back
-
-=head1 AUTHORS & ACKNOWLEDGEMENTS
-
-FLAT is written by Mike Rosulek E<lt>mike at mikero dot comE<gt> and
-Brett Estrade E<lt>estradb at gmail dot comE<gt>.
-
-The initial version (FLAT::Legacy) by Brett Estrade was work towards an
-MS thesis at the University of Southern Mississippi.
-
-Please visit the Wiki at http://www.0x743.com/flat
-
-=head1 LICENSE
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself.
diff --git a/lib/FLAT/Regex/Op.pm b/lib/FLAT/Regex/Op.pm
deleted file mode 100644
index 76e796c..0000000
--- a/lib/FLAT/Regex/Op.pm
+++ /dev/null
@@ -1,282 +0,0 @@
-package FLAT::Regex::Op;
-use strict;
-
-sub new {
- my $pkg = shift;
- ## flatten alike operations, i.e, "a+(b+c)" into "a+b+c"
- my @flat = map { UNIVERSAL::isa($_, $pkg) ? $_->members : $_ } @_;
-
- bless \@flat, $pkg;
-}
-
-sub members {
- my $self = shift;
- wantarray ? @$self[0 .. $#$self] : $self->[0];
-}
-
-
-#################################
-#### regex operators / components
-
-package FLAT::Regex::Op::atomic;
-use base 'FLAT::Regex::Op';
-
-sub as_string {
- my $t = $_[0]->members;
-
- return "#" if not defined $t;
- return $t =~ /^\w$/
- ? $t
- : "[$t]";
-}
-
-sub as_perl_regex {
- my $r = $_[0]->members;
-
- return "(?!)" if not defined $r;
-
- $r = quotemeta $r;
- return $r =~ /^\w$/ ? $r : "(?:$r)";
-}
-
-sub as_nfa {
- FLAT::NFA->singleton( $_[0]->members );
-}
-
-sub as_pfa {
- FLAT::PFA->singleton( $_[0]->members );
-}
-
-sub from_parse {
- my ($pkg, @item) = @_;
- my $i = $item[1];
-
- return $pkg->new("") if $i eq "[]";
- return $pkg->new(undef) if $i eq "#";
-
- $i =~ s/^\[|\]$//g;
-
- return $pkg->new($i);
-}
-
-sub reverse {
- $_[0];
-}
-
-sub is_empty {
- not defined $_[0]->members;
-}
-
-sub has_nonempty_string {
- my $self = shift;
- defined $self->members and length $self->members;
-}
-
-sub is_finite {
- 1
-}
-
-##############################
-package FLAT::Regex::Op::star;
-use base 'FLAT::Regex::Op';
-
-sub parse_spec { "%s '*'" }
-sub precedence { 30 }
-
-sub as_string {
- my ($self, $prec) = @_;
- my $result = $self->members->as_string($self->precedence) . "*";
- return $prec > $self->precedence ? "($result)" : $result;
-}
-
-sub as_perl_regex {
- my ($self, $prec) = @_;
- my $result = $self->members->as_perl_regex($self->precedence) . "*";
- return $prec > $self->precedence ? "(?:$result)" : $result;
-}
-
-sub as_nfa {
- my $self = shift;
- $self->members->as_nfa->kleene;
-}
-
-sub as_pfa {
- my $self = shift;
- $self->members->as_pfa->kleene;
-}
-
-sub from_parse {
- my ($pkg, @item) = @_;
- $pkg->new( $item[1] );
-}
-
-sub reverse {
- my $self = shift;
- my $op = $self->members->reverse;
- __PACKAGE__->new($op);
-}
-
-sub is_empty {
- 0
-}
-
-sub has_nonempty_string {
- $_[0]->members->has_nonempty_string;
-}
-
-sub is_finite {
- ! $_[0]->members->has_nonempty_string;
-}
-
-
-################################
-package FLAT::Regex::Op::concat;
-use base 'FLAT::Regex::Op';
-
-sub parse_spec { "%s(2..)"; }
-sub precedence { 20 }
-
-sub as_string {
- my ($self, $prec) = @_;
- my $result = join "",
- map { $_->as_string($self->precedence) }
- $self->members;
- return $prec > $self->precedence ? "($result)" : $result;
-}
-
-sub as_perl_regex {
- my ($self, $prec) = @_;
- my $result = join "",
- map { $_->as_perl_regex($self->precedence) }
- $self->members;
- return $prec > $self->precedence ? "(?:$result)" : $result;
-}
-
-sub as_nfa {
- my $self = shift;
- my @parts = map { $_->as_nfa } $self->members;
- $parts[0]->concat( @parts[1..$#parts] );
-}
-
-sub as_pfa {
- my $self = shift;
- my @parts = map { $_->as_pfa } $self->members;
- $parts[0]->concat( @parts[1..$#parts] );
-}
-
-sub from_parse {
- my ($pkg, @item) = @_;
- $pkg->new( @{ $item[1] } );
-}
-
-## note: "reverse" conflicts with perl builtin
-sub reverse {
- my $self = shift;
- my @ops = CORE::reverse map { $_->reverse } $self->members;
- __PACKAGE__->new(@ops);
-}
-
-sub is_empty {
- my $self = shift;
- my @members = $self->members;
- for (@members) {
- return 1 if $_->is_empty;
- }
- return 0;
-}
-
-sub has_nonempty_string {
- my $self = shift;
- return 0 if $self->is_empty;
-
- my @members = $self->members;
- for (@members) {
- return 1 if $_->has_nonempty_string;
- }
- return 0;
-}
-
-sub is_finite {
- my $self = shift;
- return 1 if $self->is_empty;
-
- my @members = $self->members;
- for (@members) {
- return 0 if not $_->is_finite;
- }
- return 1;
-}
-
-#############################
-package FLAT::Regex::Op::alt;
-use base 'FLAT::Regex::Op';
-
-sub parse_spec { "%s(2.. /[+|]/)" }
-sub precedence { 10 }
-
-sub as_string {
- my ($self, $prec) = @_;
- my $result = join "+",
- map { $_->as_string($self->precedence) }
- $self->members;
- return $prec > $self->precedence ? "($result)" : $result;
-}
-
-sub as_perl_regex {
- my ($self, $prec) = @_;
- my $result = join "|",
- map { $_->as_perl_regex($self->precedence) }
- $self->members;
- return $prec > $self->precedence ? "(?:$result)" : $result;
-}
-
-sub as_nfa {
- my $self = shift;
- my @parts = map { $_->as_nfa } $self->members;
- $parts[0]->union( @parts[1..$#parts] );
-}
-
-sub as_pfa {
- my $self = shift;
- my @parts = map { $_->as_pfa } $self->members;
- $parts[0]->union( @parts[1..$#parts] );
-}
-
-sub from_parse {
- my ($pkg, @item) = @_;
- $pkg->new( @{ $item[1] } );
-}
-
-sub reverse {
- my $self = shift;
- my @ops = map { $_->reverse } $self->members;
- __PACKAGE__->new(@ops);
-}
-
-sub is_empty {
- my $self = shift;
- my @members = $self->members;
- for (@members) {
- return 0 if not $_->is_empty;
- }
- return 1;
-}
-
-sub has_nonempty_string {
- my $self = shift;
- my @members = $self->members;
- for (@members) {
- return 1 if $_->has_nonempty_string;
- }
- return 0;
-}
-
-sub is_finite {
- my $self = shift;
- my @members = $self->members;
- for (@members) {
- return 0 if not $_->is_finite;
- }
- return 1;
-}
-1;
diff --git a/lib/FLAT/Regex/Parser.pm b/lib/FLAT/Regex/Parser.pm
deleted file mode 100644
index deb73f1..0000000
--- a/lib/FLAT/Regex/Parser.pm
+++ /dev/null
@@ -1,82 +0,0 @@
-package FLAT::Regex::Parser;
-use strict;
-
-#### Is this one level of abstraction too far? Parser generator generators..
-
-#### TODO: try YAPP, since recursive descent is SLOOOW
-use Parse::RecDescent;
-use FLAT::Regex::Op;
-
-use vars '$CHAR';
-$CHAR = qr{ [A-Za-z0-9_\$\#] | \[[^\]]*\] }x;
-
-sub new {
- my $pkg = shift;
- my @ops = sort { $a->{prec} <=> $b->{prec} }
- map {{
- pkg => "FLAT::Regex::Op::$_",
- prec => "FLAT::Regex::Op::$_"->precedence,
- spec => "FLAT::Regex::Op::$_"->parse_spec,
- short => $_
- }} @_;
-
- my $lowest = shift @ops;
- my $grammar = qq!
- parse:
- $lowest->{short} /^\\Z/ { \$item[1] }
- !;
-
- my $prev = $lowest;
- for (@ops) {
- my $spec = sprintf $prev->{spec}, $_->{short};
-
- $grammar .= qq!
- $prev->{short}:
- $spec { $prev->{pkg}\->from_parse(\@item) }
- | $_->{short} { \$item[1] }
- !;
-
- $prev = $_;
- }
-
- my $spec = sprintf $prev->{spec}, "atomic";
- $grammar .= qq!
- $prev->{short}:
- $spec { $prev->{pkg}\->from_parse(\@item) }
- | atomic { \$item[1] }
-
- atomic:
- "(" $lowest->{short} ")" { \$item[2] }
- | /\$FLAT::Regex::Parser::CHAR/
- { FLAT::Regex::Op::atomic->from_parse(\@item) }
- !;
-
- Parse::RecDescent->new($grammar);
-}
-
-1;
-
-
-__END__
-
-original parser:
-
-use vars '$CHAR';
-$CHAR = qr{ [A-Za-z0-9_\!\@\#\$\%\&] | \[[^\]]*\] }x;
-
-my $PARSER = Parse::RecDescent->new(<<'__EOG__') or die;
- parse:
- alt /^\Z/ { $item[1] }
- alt:
- concat(2.. /[+|]/) { FLAT::Regex::Op::alt->from_parse(@item) }
- | concat { $item[1] }
- concat:
- star(2..) { FLAT::Regex::Op::concat->from_parse(@item) }
- | star { $item[1] }
- star :
- atomic '*' { FLAT::Regex::Op::star->from_parse(@item) }
- | atomic { $item[1] }
- atomic:
- "(" alt ")" { $item[2] }
- | /$FLAT::Regex::CHAR/ { FLAT::Regex::Op::atomic->from_parse(@item) }
-__EOG__
diff --git a/lib/FLAT/Regex/Transform.pm b/lib/FLAT/Regex/Transform.pm
deleted file mode 100644
index cd0cf56..0000000
--- a/lib/FLAT/Regex/Transform.pm
+++ /dev/null
@@ -1,18 +0,0 @@
-package FLAT::Regex::Transform;
-
-# Extends FLAT::Regex::WithExtraOps with PRegex transformations
-# (i.e., reductions based on: w*v & a*b
-
-use base 'FLAT::Regex::WithExtraOps';
-
-sub new {
- my $pkg = shift;
- my $self = $pkg->SUPER::new(@_);
- return $self;
-}
-
-# Ideally, the transformation should be implemented as an iterator. This
-# approach will be finite for shuffles with NO closed strings, but will carry on
-# indefinitely for the shuffle of strings where at least one of the strings is closed
-
-1;
diff --git a/lib/FLAT/Regex/Util.pm b/lib/FLAT/Regex/Util.pm
deleted file mode 100644
index 516ad9f..0000000
--- a/lib/FLAT/Regex/Util.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-package FLAT::Regex::Util;
-use base 'FLAT::Regex';
-
-use strict;
-use Carp;
-
-sub get_symbol {
- my @symbols = qw/0 1/;
- return $symbols[rand(2)];
-}
-
-sub get_op {
- my @ops = ('*','+','&','','','','','','','');
- return $ops[rand(10)];
-}
-
-sub get_random {
- my $length = shift;
- my $string = '';
- if (1 < $length) {
- $string = get_symbol().get_op().get_random(--$length);
- } else {
- $string = get_symbol();
- }
- return $string;
-}
-
-sub random_pre {
- my $length = ( $_[0] ? $_[0] : 32 );
- return FLAT::Regex::WithExtraOps->new(get_random($length));
-}
-
-1;
diff --git a/lib/FLAT/Regex/WithExtraOps.pm b/lib/FLAT/Regex/WithExtraOps.pm
deleted file mode 100644
index b366d7c..0000000
--- a/lib/FLAT/Regex/WithExtraOps.pm
+++ /dev/null
@@ -1,109 +0,0 @@
-package FLAT::Regex::WithExtraOps;
-use base 'FLAT::Regex';
-
-use strict;
-use Carp;
-
-my $PARSER = FLAT::Regex::Parser->new(qw[ alt concat star negate shuffle ]);
-sub _parser { $PARSER }
-
-sub members {
- my $self = shift;
- wantarray ? @$self[0 .. $#$self] : $self->[0];
-}
-
-#### Precedence
-# 30 ::star
-# 20 ::concat
-# 15 ::negate <---<< WithExtraOps
-# 12 ::shuffle <---<< WithExtraOps
-# 10 ::alt
-# 0 ::atomic
-
-###############################
-package FLAT::Regex::Op::negate;
-use base "FLAT::Regex::Op";
-use Carp;
-
-sub parse_spec { "'~' %s"; }
-sub precedence { 15 } # between concat and alternation
-
-sub as_string {
- my ($self, $prec) = @_;
- my $result = "~" . $self->members->as_string($self->precedence);
- return $prec > $self->precedence ? "($result)" : $result;
-}
-
-sub from_parse {
- my ($pkg, @item) = @_;
- $pkg->new( $item[2] );
-}
-
-## note: "reverse" conflicts with perl builtin
-sub reverse {
- my $self = shift;
- my $op = $self->members->reverse;
- __PACKAGE__->new($op);
-}
-
-sub is_empty {
- croak "Not implemented for negated regexes";
-}
-
-sub has_nonempty_string {
- croak "Not implemented for negated regexes";
-}
-
-sub is_finite {
- croak "Not implemented for negated regexes";
-}
-
-###############################
-package FLAT::Regex::Op::shuffle;
-use base 'FLAT::Regex::Op';
-use Carp;
-
-sub parse_spec { "%s(2.. /[&]/)" }
-sub precedence { 12 }
-
-sub as_string {
- my ($self, $prec) = @_;
- my $result = join "&",
- map { $_->as_string($self->precedence) }
- $self->members;
- return $prec > $self->precedence ? "($result)" : $result;
-}
-
-sub as_perl_regex {
- my $self = shift;
- croak "Not implemented for shuffled regexes";
-}
-
-sub from_parse {
- my ($pkg, @item) = @_;
- $pkg->new( @{ $item[1] } );
-}
-
-sub as_pfa {
- my $self = shift;
- my @parts = map { $_->as_pfa } $self->members;
- $parts[0]->shuffle( @parts[1..$#parts] );
-}
-
-# Implement?
-sub reverse {
- my $self = shift;
- croak "Not implemented for shuffled regexes";
-}
-
-sub is_empty {
- croak "Not implemented for shuffled regexes";
-}
-
-sub has_nonempty_string {
- croak "Not implemented for shuffled regexes";
-}
-
-sub is_finite {
- croak "Not implemented for shuffled regexes";
-}
diff --git a/lib/FLAT/Symbol.pm b/lib/FLAT/Symbol.pm
deleted file mode 100644
index aaadccc..0000000
--- a/lib/FLAT/Symbol.pm
+++ /dev/null
@@ -1,98 +0,0 @@
-#
-# Conceptual Experiment - not currently implemented anywhere...
-#
-
-package FLAT::Symbol
-
-use strict;
-use Carp;
-
-sub new {
- my ($pkg, $string, $type) = @_;
- bless {
- STRING => $string,
- TYPE => $type,
- }, $pkg;
-}
-
-sub as_string {
- return $_[0]->{STRING};
-}
-
-sub get_type }
- return $_[0]->{TYPE};
-}
-
-sub set_type {
- $_[0]->{TYPE} = $_[1];
-}
-
-1;
-
-##################
-
-package FLAT::Symbol::Regular;
-use base 'FLAT::Symbol';
-
-sub new {
- my $pkg = shift;
- my $self = $pkg->SUPER::new($_[0],'Regular');
- return $self;
-}
-
-sub get_type {
- return 'Regular';
-}
-
-sub set_type {
- croak("Sorry, can't change type for this symbol");
-}
-
-1;
-
-##################
-
-package FLAT::Symbol::Special;
-use base 'FLAT::Symbol';
-
-sub new {
- my $pkg = shift;
- my $self = $pkg->SUPER::new($_[0],'Special');
- return $self;
-}
-
-sub get_type {
- return 'Special';
-}
-
-sub set_type {
- croak("Sorry, can't change type for this symbol");}
-
-1;
-
-__END__
-
-=head1 NAME
-
-FLAT::Symbol - Base class for transition symbol.
-
-=head1 SYNOPSIS
-
-A super class that is intended to provide a simple mechanism for storing a symbol that might be
-in conflict with another symbol in string form. TYPE is used to distinguish. Currenly this neither
-this, nor its current sub classes, FLAT::Symbol::Regular and FLAT::Symbol::Special, are used.
-
-=head1 AUTHORS & ACKNOWLEDGEMENTS
-
-FLAT is written by Mike Rosulek E<lt>mike at mikero dot comE<gt> and
-Brett Estrade E<lt>estradb at gmail dot comE<gt>.
-
-The initial version (FLAT::Legacy) by Brett Estrade was work towards an
-MS thesis at the University of Southern Mississippi.
-
-Please visit the Wiki at http://www.0x743.com/flat
-
-=head1 LICENSE
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself.
diff --git a/lib/FLAT/Transition.pm b/lib/FLAT/Transition.pm
deleted file mode 100644
index fc385f3..0000000
--- a/lib/FLAT/Transition.pm
+++ /dev/null
@@ -1,66 +0,0 @@
-package FLAT::Transition;
-use strict;
-use Carp;
-
-sub new {
- my ($pkg, @things) = @_;
- bless { map { $_ => 1 } @things }, $pkg;
-}
-
-sub does {
- my ($self, @things) = @_;
- return 1 if @things == 0;
- return !! grep $self->{$_}, @things;
-}
-
-sub add {
- my ($self, @things) = @_;
- @$self{@things} = (1) x @things;
-}
-
-sub delete {
- my ($self, @things) = @_;
- delete $self->{$_} for @things;
-}
-
-sub alphabet {
- my $self = shift;
- sort { $a cmp $b } keys %$self;
-}
-
-sub as_string {
- my $self = shift;
- join ",", map { length $_ ? $_ : "epsilon" } $self->alphabet;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-FLAT::Transition - a transition base class.
-
-=head1 SYNOPSIS
-
-Default implementation of the Transition class, used to manage transitions
-from one state to others. This class is meant for internal use.
-
-=head1 USAGE
-
-used internally;
-
-=head1 AUTHORS & ACKNOWLEDGEMENTS
-
-FLAT is written by Mike Rosulek E<lt>mike at mikero dot comE<gt> and
-Brett Estrade E<lt>estradb at gmail dot comE<gt>.
-
-The initial version (FLAT::Legacy) by Brett Estrade was work towards an
-MS thesis at the University of Southern Mississippi.
-
-Please visit the Wiki at http://www.0x743.com/flat
-
-=head1 LICENSE
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself.
diff --git a/lib/FLAT/XFA.pm b/lib/FLAT/XFA.pm
deleted file mode 100644
index 67e073c..0000000
--- a/lib/FLAT/XFA.pm
+++ /dev/null
@@ -1,3 +0,0 @@
-package FLAT::XFA;
-
-1;
diff --git a/lib/Kratos/DFADriver.pm b/lib/Kratos/DFADriver.pm
deleted file mode 100644
index deb758c..0000000
--- a/lib/Kratos/DFADriver.pm
+++ /dev/null
@@ -1,1423 +0,0 @@
-package Kratos::DFADriver;
-
-use strict;
-use warnings;
-use 5.020;
-
-use parent 'Class::Accessor';
-
-use Archive::Tar;
-use AspectC::Repo;
-use Carp;
-use Carp::Assert::More;
-use Cwd;
-use Data::Dumper;
-use DateTime;
-use Device::SerialPort;
-use File::Slurp qw(read_dir read_file write_file);
-use IPC::Run qw(harness);
-use JSON;
-use Kratos::DFADriver::DFA;
-use Kratos::DFADriver::Model;
-use List::Util qw(first);
-use List::MoreUtils qw(pairwise);
-use MIMOSA;
-use MIMOSA::Log;
-
-Kratos::DFADriver->mk_ro_accessors(qw(class_name dfa mimosa model repo));
-
-our $VERSION = '0.00';
-
-sub new {
- my ( $class, %opt ) = @_;
-
- my $self = \%opt;
-
- $self->{dfa} = Kratos::DFADriver::DFA->new(%opt);
- $self->{mimosa} = MIMOSA->new(%opt);
- $self->{repo} = AspectC::Repo->new;
- $self->{lp}{iteration} = 1;
-
- if ( -r $opt{model_file} ) {
- $self->{model} = Kratos::DFADriver::Model->new(%opt);
- $self->{class_name} = $self->{model}->class_name;
- }
- elsif ( $opt{class_name} ) {
- $self->{model} = Kratos::DFADriver::Model->new_from_repo(
- repo => $self->{repo},
- class_name => $opt{class_name},
- model_file => $opt{model_file},
- );
- }
- else {
- die('Neither driver.json nor class name specified, cannot continue');
- }
-
- bless( $self, $class );
-
- $self->set_paths;
- $self->dfa->set_model( $self->model );
-
- return $self;
-}
-
-sub set_paths {
- my ($self) = @_;
-
- my $model_path = $self->{model_file};
- $model_path =~ s{ /?+dfa-driver/[^/]+[.] ( xml | json ) $ }{}x;
-
- my $prefix = $self->{prefix} = cwd() . "/${model_path}/src";
- my $class_prefix
- = $self->repo->get_class_path_prefix( $self->{class_name} );
- $self->{ah_file} = "${prefix}/${class_prefix}_dfa.ah";
- $self->{cc_file} = "${prefix}/${class_prefix}_dfa.cc.inc";
- $self->{h_file} = "${prefix}/${class_prefix}_dfa.h.inc";
-}
-
-sub set_output {
- my ( $self, $mode ) = @_;
-
- if ( $mode eq 'tex' ) {
- $self->{tex} = 1;
- }
-
- return $self;
-}
-
-sub preprocess {
- my ( $self, @files ) = @_;
- my @logs;
- my @json_files;
-
- for my $i ( 0 .. $#files ) {
- push(
- @logs,
- MIMOSA::Log->new(
- data_file => $files[$i],
- fast_analysis => $self->{fast_analysis},
- model => $self->model,
- merge_args => $self->{merge_args},
- tmpsuffix => $i,
- )
- );
- }
-
- for my $log (@logs) {
- if ( not $self->{cache} or not $log->load_cache ) {
- $log->load_archive;
- $log->preprocess;
- $log->save_cache;
- }
- push( @json_files, $log->json_name );
- }
-
- $self->{log} = $logs[0];
- return ( \@logs, \@json_files );
-}
-
-sub analyze {
- my ( $self, @files ) = @_;
- my ( $logs, $json_files ) = $self->preprocess(@files);
- $self->log->analyze( @{$json_files} );
-}
-
-sub crossvalidate_model {
- my ( $self, @files ) = @_;
- my ( $logs, $json_files ) = $self->preprocess(@files);
- $self->log->crossvalidate( @{$json_files} );
-}
-
-sub log {
- my ( $self, $file ) = @_;
-
- if ($file) {
- $self->{log} = undef;
- }
-
- $self->{log} //= MIMOSA::Log->new(
- data_file => $file // $self->{data_file},
- fast_analysis => $self->{fast_analysis},
- model => $self->model,
- merge_args => $self->{merge_args}
- );
-
- return $self->{log};
-}
-
-sub assess_fits {
- my ( $self, $hash, $param, $funtype ) = @_;
-
- $funtype //= 'fit_guess';
-
- my $errmap = $hash->{$funtype}{$param};
- my @errors = map { [ $_, $errmap->{$_} ] } keys %{$errmap};
- @errors = sort { $a->[1]{rmsd} <=> $b->[1]{rmsd} } @errors;
-
- my $min_err = $errors[0][1]{rmsd};
- @errors = grep { $_->[1]{rmsd} <= 2 * $min_err } @errors;
- my @function_types = map {
- sprintf( '%s (%.f / %.2f%%)', $_->[0], $_->[1]{rmsd}, $_->[1]{smape} )
- } @errors;
-
- return @function_types;
-}
-
-sub printf_aggr {
- my ( $self, $hash, $key, $unit ) = @_;
-
- $hash = $hash->{$key};
-
- if ( exists $hash->{median_goodness}{smape} ) {
- printf(
- " %s: static error: %.2f%% / %.f %s (σ = %.f)\n",
- $key,
- $hash->{median_goodness}{smape},
- $hash->{median_goodness}{mae},
- $unit, $hash->{std_inner}
- );
-
-#printf(" %s: median %.f (%.2f / %.2f%%), mean %.f (%.2f / %.2f%%), σ %.f %s\n",
-# $key,
-# $hash->{median},
-# $hash->{median_goodness}{mae} // -1,
-# $hash->{median_goodness}{smape} // -1,
-# $hash->{mean},
-# $hash->{mean_goodness}{mae} // -1,
-# $hash->{mean_goodness}{smape} // -1,
-# $hash->{std_inner},
-# $unit
-#);
- }
- else {
- printf(
- " %s: static error: %.f %s (σ = %.f)\n",
- $key, $hash->{median_goodness}{mae},
- $unit, $hash->{std_inner}
- );
-
- #printf(
- # " %s: median %.f (%.2f), mean %.f (%.2f), σ %.f %s\n",
- # $key, $hash->{median}, $hash->{median_goodness}{mae},
- # $hash->{mean}, $hash->{mean_goodness}{mae},
- # $hash->{std_inner}, $unit
- #);
- }
-}
-
-sub printf_counter_status {
- my ( $self, $hash, $key ) = @_;
-
- $hash = $hash->{$key};
-
- if ( 2**32 / $hash->{median} < 10e6 ) {
- printf( " %s: 32bit energy counter will overflow after %.f ms\n",
- 'power', ( 2**32 / $hash->{median} ) / 1000 );
- }
-}
-
-sub printf_aggr_tex {
- my ( $self, $hash, $key, $unit, $divisor ) = @_;
-
- $hash = $hash->{$key};
-
- if ( $unit eq 'ms' and $hash->{median} < 1e3 ) {
- $unit = '\us';
- $divisor = 1;
- }
- elsif ( $unit eq '\uJ' and $hash->{median} < 1e6 ) {
- $unit = 'nJ';
- $divisor = 1e3;
- }
- elsif ( $unit eq '\uW' and $hash->{median} >= 1e3 ) {
- $unit = 'mW';
- $divisor = 1e3;
- }
-
- use locale;
-
- printf( ' & & \unit[%.3g]{%s}', $hash->{median} / $divisor, $unit );
-}
-
-sub printf_count_tex {
- my ( $self, $hash, $key ) = @_;
-
- if ($hash) {
- $hash = $hash->{$key};
-
- printf( ' & %d', $hash->{count} );
- }
- else {
- printf(' & ');
- }
-}
-
-sub printf_eval_tex {
- my ( $self, $hash, $key, $unit, $divisor ) = @_;
-
- $hash = $hash->{$key};
-
- if ( $unit eq 'ms' and $hash->{median_goodness}{mae} < 1e3 ) {
- $unit = '\us';
- $divisor = 1;
- }
- if ( $unit eq '\uJ' and $hash->{median_goodness}{mae} < 1e6 ) {
- $unit = 'nJ';
- $divisor = 1e3;
- }
-
- use locale;
-
- printf(
- "\n%20s & \\unit[%.3g]{%s} & \\unit[%.2g]{\\%%}",
- q{}, $hash->{median_goodness}{mae} / $divisor,
- $unit, $hash->{median_goodness}{smape} // -1
- );
-}
-
-sub printf_goodness {
- my ( $self, $modval, $hash, $key, $unit ) = @_;
-
- $hash = $hash->{$key};
-
- if ( exists $hash->{goodness}->{smape} ) {
- printf(
-" %s: model %.f %s, log ~=%.f / µ=%.f %s, mean absolute error %.2f %s (%.2f%%)\n",
- $key, $modval,
- $unit, $hash->{median},
- $hash->{mean}, $unit,
- $hash->{goodness}->{mae}, $unit,
- $hash->{goodness}{smape}
- );
- }
- else {
- printf(
-" %s: model %.f %s, log ~=%.f / µ=%.f %s, mean absolute error %.2f %s\n",
- $key, $modval, $unit, $hash->{median}, $hash->{mean}, $unit,
- $hash->{goodness}->{mae}, $unit );
- }
-}
-
-sub printf_online_goodness {
- my ( $self, $hash, $key, $unit ) = @_;
-
- $hash = $hash->{$key};
-
- if ( exists $hash->{goodness}->{smape} ) {
- printf(
- " %s: ~=%.f / µ=%.f %s, mean absolute error %.2f %s (%.2f%%)\n",
- $key, $hash->{median}, $hash->{mean}, $unit,
- $hash->{goodness}->{mae},
- $unit, $hash->{goodness}{smape}
- );
- }
- else {
- printf( " %s: ~=%.f / µ=%.f %s, mean absolute error %.2f %s\n",
- $key, $hash->{median}, $hash->{mean}, $unit,
- $hash->{goodness}->{mae}, $unit );
- }
-}
-
-sub printf_clip {
- my ( $self, $hash ) = @_;
-
- if ( $hash->{clip}{max} > 0.01 ) {
- printf(
- " WARNING: Up to %.f%% clipping in power measurements (avg %.f%%)"
- . ", results are unreliable\n",
- $hash->{clip}{max} * 100,
- $hash->{clip}{mean} * 100
- );
- }
-}
-
-sub printf_parameterized {
- my ( $self, $hash, $key ) = @_;
- $hash = $hash->{$key};
-
- my $std_global = $hash->{std_inner};
- my $std_ind_arg = $hash->{std_arg};
- my $std_ind_param = $hash->{std_param};
- my $std_ind_trace = $hash->{std_trace};
- my $std_by_arg = $hash->{std_by_arg} // {};
- my $std_by_param = $hash->{std_by_param};
- my $std_by_trace = $hash->{std_by_trace} // {};
- my $r_by_param = $hash->{spearmanr_by_param} // {};
- my $arg_ratio;
- my $param_ratio;
- my $trace_ratio;
-
- if ( $std_global > 0 ) {
- $param_ratio = $std_ind_param / $std_global;
- if ( defined $std_ind_arg ) {
- $arg_ratio = $std_ind_arg / $std_global;
- }
- }
- if ( $std_ind_param > 0 ) {
- $trace_ratio = $std_ind_trace / $std_ind_param;
- }
-
- if ( $std_global > 10
- and $param_ratio < 0.5
- and not exists $hash->{function}{user} )
- {
- printf( " %s: should be parameterized (%.2f / %.2f = %.3f)\n",
- $key, $std_ind_param, $std_global, $param_ratio );
- }
- if (
- (
- $std_global < 10
- or $param_ratio > 0.5
- )
- and exists $hash->{function}{user}
- )
- {
- printf( " %s: should not be parameterized (%.2f / %.2f = %.3f)\n",
- $key, $std_ind_param, $std_global,
- $param_ratio ? $param_ratio : 0 );
- }
-
- if ( defined $std_ind_arg
- and $std_global > 10
- and $arg_ratio < 0.5
- and not exists $hash->{function}{user_arg} )
- {
- printf( " %s: depends on arguments (%.2f / %.2f = %.3f)\n",
- $key, $std_ind_arg, $std_global, $arg_ratio );
- }
- if (
- defined $std_ind_arg
- and ( $std_global < 10
- or $arg_ratio > 0.5 )
- and exists $hash->{function}{user_arg}
- )
- {
- printf( " %s: should not depend on arguments (%.2f / %.2f = %.3f)\n",
- $key, $std_ind_arg, $std_global, $arg_ratio ? $arg_ratio : 0 );
- }
-
- if ( $std_global > 10 and $trace_ratio < 0.5 ) {
- printf(
- " %s: model insufficient, depends on trace (%.2f / %.2f = %.3f)\n",
- $key, $std_ind_trace, $std_ind_param, $trace_ratio );
- }
-
- if ( $std_global < 10 ) {
- return;
- }
-
- for my $param ( sort keys %{$std_by_param} ) {
- my $std_this = $std_by_param->{$param};
- my $ratio = $std_ind_param / $std_this;
- my $status = 'does not depend';
- my $fline = q{};
- if ( $ratio < 0.6 ) {
- $status = 'might depend';
- $fline = q{, probably };
- $fline .= join( ' or ', $self->assess_fits( $hash, $param ) );
- }
- if ( $ratio < 0.3 ) {
- $status = 'depends';
- }
- if ($fline) {
- printf( " %s: %s on global %s (%.2f / %.2f = %.3f%s)\n",
- $key, $status, $param, $std_ind_param, $std_this, $ratio,
- $fline );
- }
- if ( exists $r_by_param->{$param} ) {
- printf( " %s: spearman_r for global %s is %.3f (p = %.3f)\n",
- $key, $param, $r_by_param->{$param}, -1 );
- }
- }
-
- for my $arg ( sort keys %{$std_by_arg} ) {
- my $std_this = $std_by_arg->{$arg};
- my $ratio = $std_ind_arg / $std_this;
- my $status = 'does not depend';
- my $fline = q{};
- if ( $ratio < 0.6 ) {
- $status = 'might depend';
- $fline = q{, probably };
- $fline .= join( ' or ',
- $self->assess_fits( $hash, $arg, 'arg_fit_guess' ) );
- }
- if ( $ratio < 0.3 ) {
- $status = 'depends';
- }
- if ($fline) {
- printf( " %s: %s on local %s (%.2f / %.2f = %.3f%s)\n",
- $key, $status, $arg, $std_ind_arg, $std_this, $ratio, $fline );
- }
- }
-
- for my $transition ( sort keys %{$std_by_trace} ) {
- my $std_this = $std_by_trace->{$transition};
- my $ratio = $std_ind_trace / $std_this;
- if ( $ratio < 0.4 ) {
- printf(
-" %s: depends on presence of %s in trace (%.2f / %.2f = %.3f)\n",
- $key, $transition, $std_ind_trace, $std_this, $ratio );
- }
- }
-}
-
-sub printf_fit {
- my ( $self, $hash, $key, $unit ) = @_;
- $hash = $hash->{$key};
-
- for my $funtype ( sort keys %{ $hash->{function} } ) {
- if ( exists $hash->{function}{$funtype}{error} ) {
- printf( " %s: %s function could not be fitted: %s\n",
- $key, $funtype, $hash->{function}{$funtype}{error} );
- }
- else {
- printf(
- " %s: %s function fit error: %.2f%% / %.f %s\n",
- $key, $funtype,
- $hash->{function}{$funtype}{fit}{smape} // -1,
- $hash->{function}{$funtype}{fit}{mae}, $unit
- );
- }
- }
-
- for my $pair (
- [ 'param_mean_goodness', 'param mean/ssr-fit' ],
- [ 'param_median_goodness', 'param median/static' ],
- [ 'arg_mean_goodness', 'arg mean/ssr-fit' ],
- [ 'arg_median_goodness', 'arg median/static' ]
- )
- {
- my ( $goodness, $desc ) = @{$pair};
- if ( exists $hash->{$goodness} ) {
- printf(
- " %s: %s LUT error: %.2f%% / %.f %s / %.f\n",
- $key, $desc,
- $hash->{$goodness}{smape} // -1,
- $hash->{$goodness}{mae},
- $unit, $hash->{$goodness}{rmsd}
- );
- }
- }
-}
-
-sub assess_model {
- my ($self) = @_;
-
- for my $name ( sort keys %{ $self->{log}{aggregate}{state} } ) {
- my $state = $self->{log}{aggregate}{state}{$name};
-
- printf( "Assessing %s:\n", $name );
-
- $self->printf_clip($state);
- $self->printf_aggr( $state, 'power', 'µW' );
- $self->printf_counter_status( $state, 'power' );
- $self->printf_parameterized( $state, 'power' );
- $self->printf_fit( $state, 'power', 'µW' );
- }
- for my $name ( sort keys %{ $self->{log}{aggregate}{transition} } ) {
- my $transition = $self->{log}{aggregate}{transition}{$name};
-
- printf( "Assessing %s:\n", $name );
-
- $self->printf_clip($transition);
- $self->printf_aggr( $transition, 'duration', 'µs' );
- $self->printf_parameterized( $transition, 'duration' );
- $self->printf_fit( $transition, 'duration', 'µs' );
- $self->printf_aggr( $transition, 'energy', 'pJ' );
- $self->printf_parameterized( $transition, 'energy' );
- $self->printf_fit( $transition, 'energy', 'pJ' );
- $self->printf_aggr( $transition, 'rel_energy_prev', 'pJ' );
- $self->printf_parameterized( $transition, 'rel_energy_prev' );
- $self->printf_fit( $transition, 'rel_energy_prev', 'pJ' );
-
- if ( exists $transition->{rel_energy_next}{median} ) {
- $self->printf_aggr( $transition, 'rel_energy_next', 'pJ' );
- $self->printf_parameterized( $transition, 'rel_energy_next' );
- $self->printf_fit( $transition, 'rel_energy_next', 'pJ' );
- }
-
- if ( exists $transition->{timeout}{median} ) {
- $self->printf_aggr( $transition, 'timeout', 'µs' );
- $self->printf_parameterized( $transition, 'timeout' );
- $self->printf_fit( $transition, 'timeout', 'µs' );
- }
- }
-
-}
-
-sub assess_model_tex {
- my ($self) = @_;
- say '\begin{tabular}{|c|rrr|r|}\\hline';
- say 'Zustand & $\MmedP$ & & & $n$ \\\\\\hline';
- for my $name ( sort keys %{ $self->{log}{aggregate}{state} } ) {
- my $state = $self->{log}{aggregate}{state}{$name};
-
- printf( "\n%20s", $name );
-
- $self->printf_aggr_tex( $state, 'power', '\uW', 1 );
- $self->printf_eval_tex( $state, 'power', '\uW', 1 );
- $self->printf_count_tex( $state, 'power' );
- print " \\\\";
- }
- say '\end{tabular}\\\\';
- say '\vspace{0.5cm}';
- say '\begin{tabular}{|c|rr|rr|rr|r|}\\hline';
- say 'Transition & & $\MmedE$ & & $\MmedF$ & & $\Mmeddur$ & $n$ \\\\\\hline';
- for my $name ( sort keys %{ $self->{log}{aggregate}{transition} } ) {
- my $transition = $self->{log}{aggregate}{transition}{$name};
-
- printf( "\n%20s", $name );
-
- $self->printf_aggr_tex( $transition, 'energy', '\uJ', 1e6 );
- $self->printf_aggr_tex( $transition, 'rel_energy_prev', '\uJ', 1e6 );
- $self->printf_aggr_tex( $transition, 'rel_energy_next', '\uJ', 1e6 );
- $self->printf_aggr_tex( $transition, 'duration', 'ms', 1e3 );
- $self->printf_count_tex( $transition, 'energy' );
- print " \\\\";
- $self->printf_eval_tex( $transition, 'energy', '\uJ', 1e6 );
- $self->printf_eval_tex( $transition, 'rel_energy_prev', '\uJ', 1e6 );
- $self->printf_eval_tex( $transition, 'rel_energy_next', '\uJ', 1e6 );
- $self->printf_eval_tex( $transition, 'duration', 'ms', 1e3 );
- $self->printf_count_tex;
- print " \\\\";
- }
- print "\\hline\n";
- say '\end{tabular}';
-}
-
-sub assess_workload {
- my ( $self, $workload ) = @_;
-
- $workload =~ s{ \s* \) \s* ; \s* }{:}gx;
- $workload =~ s{ \s* \) \s* $ }{}gx;
- $workload =~ s{ \s* ; \s* }{!:}gx;
- $workload =~ s{ \s* \( \s* }{!}gx;
- $workload =~ s{ \s* , \s* }{!}gx;
- $workload =~ s{ [^!] \K $ }{!}gx;
-
- say $workload;
-
- my $traces = $self->dfa->run_str_to_trace($workload);
-}
-
-sub update_model {
- my ($self) = @_;
-
- for my $name ( sort keys %{ $self->{log}{aggregate}{state} } ) {
- my $state = $self->{log}{aggregate}{state}{$name};
- $self->model->set_state_power( $name, $state->{power}{median} );
- for my $fname ( keys %{ $state->{power}{function} } ) {
- $self->model->set_state_params(
- $name, $fname,
- $state->{power}{function}{$fname}{raw},
- @{ $state->{power}{function}{$fname}{params} }
- );
- }
- if ( $self->{with_lut} ) {
- $self->model->set_state_lut( $name, 'power',
- $state->{power}{median_by_param} );
- }
- }
- for my $name ( sort keys %{ $self->{log}{aggregate}{transition} } ) {
- my $transition = $self->{log}{aggregate}{transition}{$name};
- my @keys = (qw(duration energy rel_energy_prev rel_energy_next));
-
- if (
- $self->model->get_transition_by_name($name)->{level} eq 'epilogue' )
- {
- push( @keys, 'timeout' );
- }
-
- for my $key (@keys) {
- $self->model->set_transition_property( $name, $key,
- $transition->{$key}{median} );
- for my $fname ( keys %{ $transition->{$key}{function} } ) {
- $self->model->set_transition_params(
- $name,
- $key,
- $fname,
- $transition->{$key}{function}{$fname}{raw},
- @{ $transition->{$key}{function}{$fname}{params} }
- );
- }
- if ( $self->{with_lut} ) {
- $self->model->set_transition_lut( $name, $key,
- $transition->{$key}{median_by_param} );
- }
- }
- }
-
- $self->model->set_voltage(
- $self->{log}{aggregate}{min_voltage},
- $self->{log}{aggregate}{max_voltage}
- );
-
- $self->model->save;
-}
-
-sub reset_model {
- my ($self) = @_;
-
- $self->model->reset;
- $self->model->save;
-}
-
-sub to_ah {
- my ($self) = @_;
- my $class_name = $self->{class_name};
- my $repo = $self->repo;
- my $class_header = $repo->{class}{$class_name}{sources}[0]{file};
-
- my @transition_names
- = grep { $_ ne q{?} } map { $_->{name} } $self->model->transitions;
-
- my $trigger_port = $self->{trigger_port};
- my $trigger_pin = $self->{trigger_pin};
-
- my $ignore_nested = q{};
- my $adv_type = 'execution';
- my $pass_function = $self->{logging} ? 'logTransition' : 'passTransition';
-
- if ( $self->{ignore_nested} ) {
- $adv_type = 'call';
- $ignore_nested = "&& !within(\"${class_name}\")";
- }
-
- my $ah_buf = <<"EOF";
-
-#ifndef ${class_name}_DFA_AH
-#define ${class_name}_DFA_AH
-
-#include "drivers/dfa_driver.h"
-#include "drivers/gpio.h"
-#include "drivers/eUSCI_A/uart/prototype_uart.h"
-#include "${class_header}"
-
-EOF
-
- if ( defined $trigger_port and defined $trigger_pin ) {
-
- $ah_buf .= "aspect ${class_name}_Trigger {\n\n";
-
- $ah_buf .= 'pointcut Transition() = "'
- . join( q{" || "},
- map { "% ${class_name}::$_(...)" } @transition_names )
- . "\";\n\n";
- $ah_buf .= <<"EOF";
-
- advice execution("void initialize_devices()") : after() {
- setOutput(${trigger_port}, ${trigger_pin});
- }
-
- advice ${adv_type}(Transition()) ${ignore_nested} : before() {
- pinHigh(${trigger_port}, ${trigger_pin});
- }
- advice ${adv_type}(Transition()) ${ignore_nested} : after() {
- /* 22 = 10.2us delay @ 16MHz */
- /* 32 = 14.6us delay @ 16MHz */
- /* 64 = 28.6us delay @ 16MHz */
- /* 160 = 50.6us delay @ 16MHz */
- for (unsigned int i = 0; i < 64; i++)
- asm volatile("nop");
- pinLow(${trigger_port}, ${trigger_pin});
- }
-
- advice execution(Transition()) : order("${class_name}_DFA", "${class_name}_Trigger");
-
-EOF
-
- if ( $self->{ignore_nested} ) {
- for my $transition ( $self->model->transitions ) {
- if ( $transition->{level} eq 'epilogue' ) {
- $ah_buf .= <<"EOF";
-
- advice execution("% ${class_name}::$transition->{name}(...)") : before() {
- pinHigh(${trigger_port}, ${trigger_pin});
- }
- advice execution("% ${class_name}::$transition->{name}(...)") : after() {
- for (unsigned int i = 0; i < 64; i++)
- asm volatile("nop");
- pinLow(${trigger_port}, ${trigger_pin});
- }
-
-EOF
- }
- }
- }
- $ah_buf .= "};\n\n";
- }
-
- $ah_buf .= "aspect ${class_name}_DFA {\n\n";
-
- for my $transition ( $self->model->transitions ) {
- if ( $transition->{name} ne q{?} ) {
- my $dest_state_id
- = $self->model->get_state_id( $transition->{destination} );
- if ( $transition->{level} eq 'user' ) {
- $ah_buf .= <<"EOF";
-
- advice ${adv_type}("% ${class_name}::$transition->{name}(...)") ${ignore_nested} : after() {
- tjp->target()->${pass_function}(${class_name}::statepower[tjp->target()->state],
- $transition->{rel_energy_prev}{static}, $transition->{id},
- ${dest_state_id});
- };
-
-EOF
- }
- else {
- $ah_buf .= <<"EOF";
-
- advice execution("% ${class_name}::$transition->{name}(...)") : after() {
- tjp->target()->${pass_function}(${class_name}::statepower[tjp->target()->state],
- $transition->{rel_energy_prev}{static}, $transition->{id},
- ${dest_state_id});
- };
-
-EOF
- }
- }
- }
-
- $ah_buf .= <<"EOF";
-
-};
-#endif
-
-EOF
-
- return $ah_buf;
-}
-
-sub to_cc {
- my ($self) = @_;
- my $class_name = $self->{class_name};
-
- my @state_enum = $self->model->get_state_enum;
- my %param_default;
-
- for my $default_setting ( @{ $self->{param_default} } ) {
- my ( $param, $value ) = split( qr{ = }x, $default_setting );
- $param_default{$param} = $value;
- }
-
- my $buf = "DFA_Driver::power_uW_t ${class_name}::statepower[] = {" . join(
- ', ',
- map {
- sprintf(
- '%.f',
- $self->model->get_state_power_with_params(
- $_, \%param_default
- )
- )
- } @state_enum
- ) . "};\n";
-
- return $buf;
-}
-
-sub to_h {
- my ($self) = @_;
-
- my @state_enum = $self->model->get_state_enum;
-
- my $buf
- = "public:\n"
- . "static power_uW_t statepower[];\n"
- . "enum State : uint8_t {"
- . join( ', ', @state_enum ) . "};\n";
-
- return $buf;
-}
-
-sub to_tikz {
- my ($self) = @_;
-
- my $buf = <<'EOF';
-
- \begin{tikzpicture}[node distance=3cm,>=stealth',bend angle=45,auto,->]
- \tikzstyle{state}=[ellipse,thick,draw=black!75,minimum size=1cm,inner sep=2pt]
-
-EOF
-
- my @state_enum = $self->model->get_state_enum;
- my $initial = shift(@state_enum);
- my $prev = $initial;
- my $ini_name = $initial;
-
- if ( $ini_name eq 'UNINITIALIZED' ) {
- $ini_name = '?';
- }
-
- $buf
- .= "\t\t\\node [state,initial,initial text={},initial where=left] ($initial) {\\small $ini_name};\n";
- for my $state (@state_enum) {
- $buf
- .= "\t\t\\node [state,right of=${prev}] ($state) {\\small $state};\n";
- $prev = $state;
- }
-
- $buf .= "\n\t\t\\path\n";
-
- for my $transition ( $self->model->transitions ) {
- for my $transition_elem ( @{ $transition->{transitions} } ) {
- my ( $origin, $destination ) = @{$transition_elem};
- my @edgestyles;
- if ( $transition->{level} eq 'epilogue' ) {
- push( @edgestyles, 'dashed' );
- }
- if ( $origin eq $destination ) {
- push( @edgestyles, 'loop above' );
- }
- my $edgestyle
- = @edgestyles ? '[' . join( q{,}, @edgestyles ) . ']' : q{};
- $buf
- .= "\t\t ($origin) edge ${edgestyle} node {$transition->{name}} ($destination)\n";
- }
- }
- $buf .= "\t\t;\n";
- $buf .= "\t\\end{tikzpicture}\n";
-
- return $buf;
-}
-
-sub to_test_ah {
- my ($self) = @_;
-
- my $buf = <<"EOF";
-
-/*
- * Autogenerated code -- Manual changes are not preserved
- * vim:readonly
- */
-
-#ifndef DRIVEREVAL_AH
-#define DRIVEREVAL_AH
-
-#include "DriverEval.h"
-#include "syscall/guarded_scheduler.h"
-
-aspect StartDFADriverEvalThread {
- advice execution("void ready_threads()") : after() {
- organizer.Scheduler::ready(driverEvalThread);
- }
-};
-
-#endif
-
-EOF
-
- return $buf;
-}
-
-sub to_test_cc {
- my ($self) = @_;
-
- my $class_name = $self->{class_name};
- my @runs = $self->dfa->traces;
- my @state_enum = $self->model->get_state_enum;
- my $dfa = $self->dfa->dfa;
- my $num_runs = @runs;
- my $instance = $self->repo->get_class_instance( $self->{class_name} );
-
- my $state_duration = $self->{state_duration} // 1000;
-
- my $buf = <<"EOF";
-
-/*
- * Autogenerated code - Manual changes are not preserved.
- * vim:readonly
- */
-
-#include "DriverEval.h"
-#include "syscall/guarded_buzzer.h"
-
-DeclareThread(DriverEvalThread_${class_name}, driverEvalThread, 256);
-
-EOF
-
- $buf .= <<"EOF";
-void DriverEvalThread_${class_name}::action()
-{
- Guarded_Buzzer buzzer;
-
- while (1) {
-
- /* wait for MIMOSA calibration */
- buzzer.sleep(12000);
- buzzer.set(${state_duration});
-
-
-EOF
-
- $buf .= "${instance}.startIteration(${num_runs});\n";
-
- for my $run (@runs) {
- $buf .= "\t\t/* test run $run->{id} start */\n";
- $buf .= "\t\t${instance}.resetLogging();\n";
-
- # $buf .= "\t\t${instance}.resetAccounting();\n"; # TODO sinnvoll?
- my $state = 0;
- for my $transition ( grep { $_->{isa} eq 'transition' }
- @{ $run->{trace} } )
- {
- my ( $cmd, @args ) = @{ $transition->{code} };
- my ($new_state)
- = $dfa->successors( $state, ":${cmd}!" . join( '!', @args ) );
- my $state_name = $self->dfa->reduced_id_to_state($state);
- my $new_state_name = $self->dfa->reduced_id_to_state($new_state);
- $buf .= "\t\t/* Transition $state_name -> $new_state_name */\n";
-
- if ( $self->model->get_transition_by_name($cmd)->{level} eq
- 'epilogue' )
- {
- $buf .= "\t\t/* wait for $cmd interrupt */\n";
- $buf .= "\t\tbuzzer.sleep();\n";
- }
- else {
- $buf .= sprintf( "\t\t%s.%s(%s);\n",
- $instance, $cmd, join( ', ', @args ) );
- $buf .= "\t\tbuzzer.sleep();\n";
- }
- $buf .= $self->model->after_transition_code;
- $state = $new_state;
- }
- $buf .= "\t\t${instance}.dumpLog();\n\n";
- }
-
- $buf .= "${instance}.stopIteration(); }}\n";
-
- return $buf;
-}
-
-sub to_test_h {
- my ($self) = @_;
- my $class_name = $self->{class_name};
-
- my $class_prefix = $self->repo->get_class_path_prefix($class_name);
-
- my $buf = <<"EOF";
-
-/*
- * Autogenerated code -- Manual changes are not preserved
- * vim:readonly
- */
-
-#ifndef DRIVEREVAL_H
-#define DRIVEREVAL_H
-
-#include "${class_prefix}.h"
-#include "syscall/thread.h"
-
-class DriverEvalThread_${class_name} : public Thread {
- public:
- DriverEvalThread_${class_name}(void* tos) : Thread(tos) { }
- void action();
-};
-
-extern DriverEvalThread_${class_name} driverEvalThread;
-
-#endif
-
-EOF
-
- return $buf;
-}
-
-sub to_test_json {
- my ($self) = @_;
-
- return JSON->new->encode( [ $self->dfa->traces ] );
-}
-
-sub rm_acc_files {
- my ($self) = @_;
-
- for my $file ( $self->{ah_file}, $self->{cc_file}, $self->{h_file} ) {
- if ( -e $file ) {
- unlink($file);
- }
- }
-
- return $self;
-}
-
-sub write_test_files {
- my ($self) = @_;
-
- my $prefix = $self->{prefix} . '/apps/DriverEval';
-
- if ( not -d $prefix ) {
- mkdir($prefix);
- }
-
- write_file( "${prefix}/DriverEval.ah", $self->to_test_ah );
- write_file( "${prefix}/DriverEval.cc", $self->to_test_cc );
- write_file( "${prefix}/DriverEval.h", $self->to_test_h );
- write_file( "${prefix}/DriverEval.json", $self->to_test_json );
-
- # Old log may no longer apply to new test files
- unlink("${prefix}/DriverLog.txt");
-
- return $self;
-}
-
-sub rm_test_files {
- my ($self) = @_;
-
- my $prefix = $self->{prefix} . '/apps/DriverEval/DriverEval';
-
- for my $file ( "${prefix}.ah", "${prefix}.cc", "${prefix}.h" ) {
- if ( -e $file ) {
- unlink($file);
- }
- }
-
- return $self;
-}
-
-sub archive_files {
- my ($self) = @_;
-
- $self->{lp}{timestamp} //= DateTime->now( time_zone => 'Europe/Berlin' )
- ->strftime('%Y%m%d_%H%M%S');
-
- my $tar = Archive::Tar->new;
-
- my @eval_files = (
- ( map { "src/apps/DriverEval/DriverEval.$_" } (qw(ah cc h json)) ),
- ( map { "src/apps/DriverEval/DriverLog.$_" } (qw(json txt)) ),
- );
-
- my @mim_files = grep { m{ \. mim }x } read_dir('.');
-
- $tar->add_files( $self->{model_file}, @eval_files, @mim_files );
-
- $tar->add_data(
- 'setup.json',
- JSON->new->encode(
- {
- excluded_states => $self->{excluded_states},
- ignore_nested => $self->{ignore_nested},
- mimosa_offset => $self->{mimosa_offset},
- mimosa_shunt => $self->{mimosa_shunt},
- mimosa_voltage => $self->{mimosa_voltage},
- state_duration => $self->{state_duration},
- trace_filter => $self->{trace_filter},
- trace_revisit => $self->{trace_revisit},
- trigger_pin => $self->{trigger_pin},
- trigger_port => $self->{trigger_port},
- }
- )
- );
-
- my $filename = "../data/$self->{lp}{timestamp}_$self->{class_name}";
- if ( $self->{filename_suffix} ) {
- $filename .= '_' . $self->{filename_suffix};
- }
- $filename .= '.tar';
-
- $tar->write($filename);
-
- return $self;
-}
-
-sub write_acc_files {
- my ($self) = @_;
-
- write_file( $self->{ah_file}, $self->to_ah );
- write_file( $self->{cc_file}, $self->to_cc );
- write_file( $self->{h_file}, $self->to_h );
-
- return $self;
-}
-
-sub launchpad_connect {
- my ($self) = @_;
-
- $self->{port_file} //= '/dev/ttyACM1';
- $self->{port} = Device::SerialPort->new( $self->{port_file} )
- or croak("Error openig serial port $self->{port_file}");
-
- $self->{port}->baudrate( $self->{baud_rate} // 115200 );
- $self->{port}->databits(8);
- $self->{port}->parity('none');
- $self->{port}->read_const_time(500);
-
- return $self;
-}
-
-sub launchpad_flash {
- my ($self) = @_;
-
- my ( $make_buf, $prog_buf );
-
- my $remake = harness(
- [ 'make', '-B' ],
- '<' => \undef,
- '>&' => \$make_buf,
- );
-
- my $make_program = harness(
- [ 'make', 'program' ],
- '<' => \undef,
- '>&' => \$prog_buf,
- );
-
- $remake->run
- or croak( 'make -B returned ' . $remake->full_result );
- $make_program->run
- or croak( 'make program returned ' . $remake->full_result );
-
- return $self;
-}
-
-sub launchpad_reset {
- my ($self) = @_;
-
- my $output_buffer;
- my $make_reset = harness(
- [ 'make', 'reset' ],
- '<' => \undef,
- '>&' => \$output_buffer,
- );
-
- $make_reset->run
- or croak( 'make reset returned ' . $make_reset->full_result );
-
- return $self;
-}
-
-sub launchpad_log_clean {
- my ($self) = @_;
-
- for my $file ( read_dir('.') ) {
- if ( $file =~ m{ \. mim $ }x ) {
- unlink($file);
- }
- }
-}
-
-sub launchpad_log_init {
- my ($self) = @_;
-
- $self->{lp}{run_id} = 0;
- $self->{lp}{sync} = 0;
- $self->{lp}{calibrating} = 0;
- $self->{lp}{run_done} = 0;
- $self->{lp}{run} = [];
- $self->{lp}{log} = [];
- $self->{lp}{errors} = [];
- $self->{lp}{log_buf} = q{};
-
- $self->{lp}{re}{iter_start} = qr{
- ^ \[ EP \] \s iteration \s start, \s (?<runs> \d+ ) \s runs $
- }x;
- $self->{lp}{re}{iter_stop} = qr{
- ^ \[ EP \] \s iteration \s stop $
- }x;
- $self->{lp}{re}{run_start} = qr{
- ^ \[ EP \] \s run \s start $
- }x;
- $self->{lp}{re}{run_stop} = qr{
- ^ \[ EP \] \s run \s stop, \s energyUsed = (?<total_e> \S+) $
- }x;
- $self->{lp}{re}{transition} = qr{
- ^ \[ EP \] \s dt = (?<delta_t> \S+) \s de = (?<delta_e> \S+) \s
- oldst = (?<old_state> \S+ ) \s trid = (?<transition_id> \S+ ) $
- }x;
-
- $self->launchpad_connect;
-
- return $self;
-}
-
-sub launchpad_run_done {
- my ($self) = @_;
-
- if ( $self->{lp}{run_done} ) {
- $self->{lp}{run_done} = 0;
- return 1;
- }
- return 0;
-}
-
-sub launchpad_get_errors {
- my ($self) = @_;
-
- my @errors = @{ $self->{lp}{errors} };
- $self->{lp}{errors} = [];
- return @errors;
-}
-
-sub launchpad_log_is_synced {
- my ($self) = @_;
-
- return $self->{lp}{sync};
-}
-
-sub launchpad_log_status {
- my ($self) = @_;
-
- return ( $self->{lp}{iteration}, $self->{lp}{run_id},
- $self->{lp}{num_runs} );
-}
-
-sub launchpad_log_read {
- my ($self) = @_;
-
- my $port = $self->{port};
-
- my ( $count, $chars ) = $port->read(1024);
-
- $self->{lp}{log_buf} .= $chars;
-
- if ( not defined $count ) {
- $port->close;
- croak("Serial port was disconnected");
- }
- if ( $count > 0 ) {
- my @lines = split( /\n\r|\r\n/, $chars );
- for my $line (@lines) {
- $self->launchpad_parse_line($line);
- }
- }
-}
-
-sub merged_json {
- my ($self) = @_;
-
- my @traces = $self->dfa->traces;
-
- for my $run ( @{ $self->{lp}{log} } ) {
- my $trace_idx = $run->{id} - 1;
- my $idx = 0;
-
- assert_is( $traces[$trace_idx]{id}, $run->{id} );
- push( @{ $traces[$trace_idx]{total_energy} }, $run->{total_energy} );
- for my $online_obj ( @{ $run->{trace} } ) {
- my $plan_obj = $traces[$trace_idx]{trace}[$idx];
-
- #printf("%-15s %-15s\n", $plan_obj->{name}, $online_obj->{name});
-
- if ( not defined $plan_obj->{name} ) {
-
- # The planned test run is done, but the hardware reported an
- # epilogue-level transition before the next run was started.
-
- $traces[$trace_idx]{trace}[$idx] = {
- isa => $online_obj->{isa},
- name => $online_obj->{name},
- parameter =>
- $traces[$trace_idx]{trace}[ $idx - 1 ]{parameter},
- };
- if (
- exists $traces[$trace_idx]{trace}[ $idx - 1 ]
- {final_parameter} )
- {
- $traces[$trace_idx]{trace}[$idx]{parameter}
- = $traces[$trace_idx]{trace}[ $idx - 1 ]{final_parameter};
- }
- }
- else {
- if ( $online_obj->{isa} ne $plan_obj->{isa} ) {
- printf(
-"Log merge: ISA mismatch (should be %s, is %s) at index %d#%d\n",
- $plan_obj->{isa}, $online_obj->{isa}, $trace_idx,
- $idx );
- $self->mimosa->kill;
- exit(1);
- }
- if ( $plan_obj->{name} ne 'UNINITIALIZED' ) {
- if ( $online_obj->{name} ne $plan_obj->{name} ) {
- printf(
-"Log merge: name mismatch (should be %s, is %s) at index %d#%d\n",
- $plan_obj->{name}, $online_obj->{name}, $trace_idx,
- $idx );
- $self->mimosa->kill;
- exit(1);
- }
- }
- }
-
- push(
- @{ $traces[$trace_idx]{trace}[$idx]{online} },
- $online_obj->{online}
- );
-
- $idx++;
- }
- }
-
- $self->{lp}{log} = [];
-
- return @traces;
-}
-
-sub launchpad_parse_line {
- my ( $self, $line ) = @_;
-
- if ( $line =~ $self->{lp}{re}{iter_start} ) {
- $self->{lp}{sync} = 1;
- $self->{lp}{run_id} = 0;
- $self->{lp}{num_runs} = $+{runs};
- $self->{lp}{calibrating} = 0;
- }
- elsif ( not $self->{lp}{sync} ) {
- return;
- }
- elsif ( $line =~ $self->{lp}{re}{iter_stop} ) {
- $self->{lp}{iteration}++;
- $self->{lp}{calibrating} = 1;
- write_file( '../kratos/src/apps/DriverEval/DriverLog.txt',
- $self->{lp}{log_buf} );
- write_file(
- '../kratos/src/apps/DriverEval/DriverLog.json',
- JSON->new->encode( [ $self->merged_json ] )
- );
- }
- elsif ( $line =~ $self->{lp}{re}{run_start} ) {
- $self->{lp}{run_id}++;
- $self->{lp}{run} = [];
- }
- elsif ( $line =~ $self->{lp}{re}{run_stop} ) {
- $self->{lp}{run_done} = 1;
- push(
- @{ $self->{lp}{log} },
- {
- id => $self->{lp}{run_id},
- trace => [ @{ $self->{lp}{run} } ],
- total_energy => 0 + $+{total_e},
- }
- );
- }
- elsif ( $line =~ $self->{lp}{re}{transition} ) {
- push(
- @{ $self->{lp}{run} },
- {
- isa => 'state',
- name => ( $self->model->get_state_enum )[ $+{old_state} ],
- online => {
- time => 0 + $+{delta_t},
- energy => 0 + $+{delta_e},
- power => 0 + $+{delta_e} / $+{delta_t},
- },
- },
- {
- isa => 'transition',
- name =>
- $self->model->get_transition_by_id( $+{transition_id} )
- ->{name},
- online => {
- timeout => 0 + $+{delta_t},
- },
- },
- );
- }
- else {
- $self->{lp}{sync} = 0;
- push( @{ $self->{lp}{errors} }, "Cannot parse $line" );
- }
-
-}
-
-1;
diff --git a/lib/Kratos/DFADriver/DFA.pm b/lib/Kratos/DFADriver/DFA.pm
deleted file mode 100644
index 9b581d8..0000000
--- a/lib/Kratos/DFADriver/DFA.pm
+++ /dev/null
@@ -1,277 +0,0 @@
-package Kratos::DFADriver::DFA;
-
-use strict;
-use warnings;
-use 5.020;
-
-use parent 'Class::Accessor';
-
-use Data::Dumper;
-use FLAT::DFA;
-use Math::Cartesian::Product;
-
-Kratos::DFADriver::DFA->mk_ro_accessors(qw(model));
-
-our $VERSION = '0.00';
-
-sub new {
- my ( $class, %opt ) = @_;
-
- my $self = \%opt;
-
- bless( $self, $class );
-
- return $self;
-}
-
-sub set_model {
- my ( $self, $model ) = @_;
-
- $self->{model} = $model;
-
- return $self;
-}
-
-sub reduced_id_to_state {
- my ( $self, $id ) = @_;
-
- if ( not( $self->{excluded_states} and @{ $self->{excluded_states} } ) ) {
- return $self->model->get_state_name($id);
- }
-
- my @excluded
- = map { $self->model->get_state_id($_) } @{ $self->{excluded_states} };
- @excluded = reverse sort { $a <=> $b } @excluded;
- my @state_enum = $self->model->get_state_enum;
-
- for my $state (@excluded) {
- splice( @state_enum, $state, 1 );
- }
-
- return $state_enum[$id];
-}
-
-sub dfa {
- my ($self) = @_;
-
- if ( exists $self->{dfa} ) {
- return $self->{dfa};
- }
-
- my $dfa = FLAT::DFA->new();
- my @state_enum = $self->model->get_state_enum;
-
- $dfa->add_states( scalar @state_enum );
- $dfa->set_starting(0);
- $dfa->set_accepting( $dfa->get_states );
-
- for my $transition ( $self->model->transitions ) {
- print Dumper( $transition->{parameters} );
-
- for my $param ( @{ $transition->{parameters} } ) {
- if ( not defined $param->{values} ) {
- die(
-"argument values for transition $transition->{name} are undefined\n"
- );
- }
- if ( @{ $param->{values} } == 0 ) {
- die(
-"argument-value list for transition $transition->{name} is empty \n"
- );
- }
- }
-
- my @argtuples
- = cartesian { 1 } map { $_->{values} } @{ $transition->{parameters} };
-
- # cartesian will return a one-element list containing a reference to
- # an empty array if @{$transition->{parameters}} is empty
-
- for my $argtuple (@argtuples) {
- for my $transition_pair ( @{ $transition->{transitions} } ) {
- my ( $origin, $destination ) = @{$transition_pair};
- $dfa->add_transition(
- $self->model->get_state_id($origin),
- $self->model->get_state_id($destination),
- ':' . $transition->{name} . '!' . join( '!', @{$argtuple} )
- );
- }
- }
- }
-
- if ( $self->{excluded_states} and @{ $self->{excluded_states} } ) {
- my @to_delete = map { $self->model->get_state_id($_) }
- @{ $self->{excluded_states} };
- $dfa->delete_states(@to_delete);
- }
-
- $self->{dfa} = $dfa;
-
- say $dfa->as_summary;
-
- return $dfa;
-}
-
-sub run_str_to_trace {
- my ( $self, $run_str ) = @_;
- my @trace;
- my $dfa = $self->dfa;
- my %param = $self->model->parameter_hash;
- my $state = 0;
- my $state_duration = $self->{state_duration} // 1000;
- my @state_enum = $self->model->get_state_enum;
- my $prev_transition = {};
- for my $transition_str ( split( qr{ : }x, $run_str ) ) {
- my ( $cmd, @args ) = split( qr{ ! }x, $transition_str );
- my $state_name = $self->reduced_id_to_state($state);
- my $transition = $self->model->get_transition_by_name($cmd);
-
- push(
- @trace,
- {
- isa => 'state',
- name => $state_name,
- plan => {
- time => $prev_transition->{timeout}{static}
- // $state_duration,
- power => $self->model->get_state_power($state_name),
- energy => $self->model->get_state_power($state_name)
- * $state_duration,
- },
- parameter => { map { $_ => $param{$_}{value} } keys %param, },
- },
- {
- isa => 'transition',
- name => $cmd,
- args => [@args],
- code => [ $cmd, @args ],
- plan => {
- level => $transition->{level},
- energy => $transition->{energy}{static},
- timeout => $transition->{timeout}{static},
- },
- parameter => { map { $_ => $param{$_}{value} } keys %param, },
- },
- );
-
- $self->model->update_parameter_hash( \%param, $cmd, @args );
-
- ($state) = $dfa->successors( $state, ":${transition_str}" );
-
- if ( not defined $state ) {
- die("Transition $transition_str is invalid or has no successors\n");
- }
-
- $prev_transition = $transition;
- for my $extra_cmd (
- $self->model->get_state_extra_transitions( $state_enum[$state] ) )
- {
- $state_name = $self->reduced_id_to_state($state);
- $transition = $self->model->get_transition_by_name($extra_cmd);
- push(
- @trace,
- {
- isa => 'state',
- name => $state_name,
- plan => {
- time => $prev_transition->{timeout}{static}
- // $state_duration,
- power => $self->model->get_state_power($state_name),
- energy => $self->model->get_state_power($state_name)
- * $state_duration,
- },
- parameter =>
- { map { $_ => $param{$_}{value} } keys %param, },
- },
- {
- isa => 'transition',
- name => $extra_cmd,
- args => [],
- code => [$extra_cmd],
- plan => {
- level => $transition->{level},
- energy => $transition->{energy}{static},
- timeout => $transition->{timeout}{static},
- },
- parameter =>
- { map { $_ => $param{$_}{value} } keys %param, },
- }
- );
- $prev_transition = $transition;
- }
- }
-
- # required for unscheduled extra states and transitions caused by interrupts
- $trace[-1]{final_parameter}
- = { map { $_ => $param{$_}{value} } keys %param, };
- return @trace;
-}
-
-sub traces {
- my ($self) = @_;
-
- # Warning: This function is not deterministic!
- # Therefore, results are cached. When in doubt, reload traces / execution
- # plan from DriverEval.json
-
- if ( exists $self->{traces} ) {
- return @{ $self->{traces} };
- }
-
- my $max_iter = $self->{trace_revisit} // 2;
- my $next = $self->dfa->new_deepdft_string_generator($max_iter);
- my $trace_id = 1;
-
- my ( @raw_runs, @traces );
- my $filter_re;
-
- if ( $self->{trace_filter} and @{ $self->{trace_filter} } ) {
- my @res;
- for my $filter ( @{ $self->{trace_filter} } ) {
- my $re = $filter;
- $re =~ s{,}{![^:]*:}g;
- $re =~ s{$}{![^:]*)};
- $re =~ s{^}{(^};
- if ( $re =~ m{ \$ }x ) {
- $re =~ s{\$}{};
- $re =~ s{\)$}{\$)};
- }
- push( @res, $re );
- }
- $filter_re = join( q{|}, @res );
- }
-
- while ( my $run = $next->() ) {
- $run = substr( $run, 1 );
- if ( $filter_re and not $run =~ m{$filter_re} ) {
- next;
- }
- @raw_runs = grep { $_ ne substr( $run, 0, length($_) ) } @raw_runs;
- push( @raw_runs, $run );
- }
-
- if ( @raw_runs == 0 ) {
- say STDERR "--trace-filter did not match any run. Aborting.";
- exit 1;
- }
-
- @raw_runs = sort @raw_runs;
-
- for my $run_str (@raw_runs) {
- my @trace = $self->run_str_to_trace($run_str);
- push(
- @traces,
- {
- id => $trace_id,
- trace => [@trace],
- }
- );
- $trace_id++;
- }
-
- $self->{traces} = [@traces];
-
- return @traces;
-}
-
-1;
diff --git a/lib/Kratos/DFADriver/Model.pm b/lib/Kratos/DFADriver/Model.pm
deleted file mode 100644
index 4a38155..0000000
--- a/lib/Kratos/DFADriver/Model.pm
+++ /dev/null
@@ -1,495 +0,0 @@
-package Kratos::DFADriver::Model;
-
-use strict;
-use warnings;
-use 5.020;
-
-use parent 'Class::Accessor';
-
-use Carp;
-use Carp::Assert::More;
-use List::Util qw(first uniq);
-use File::Slurp qw(read_file write_file);
-use JSON;
-
-Kratos::DFADriver::Model->mk_ro_accessors(
- qw(class_name parameter state transition));
-
-our $VERSION = '0.00';
-
-sub new {
- my ( $class, %opt ) = @_;
-
- my $self = \%opt;
-
- $self->{custom_code} = {};
- $self->{parameter} = {};
- $self->{state} = {};
- $self->{transition} = {};
- $self->{voltage} = {};
-
- bless( $self, $class );
-
- my $json = JSON->new->decode( scalar read_file( $self->{model_file} ) );
- for my $key (qw(custom_code parameter state transition)) {
- $self->{$key} = $json->{$key};
- }
- $self->{class_name} = $json->{class};
-
- return $self;
-}
-
-sub new_from_repo {
- my ( $class, %opt ) = @_;
- my $repo = $opt{repo};
-
- my $self = {
- class_name => $opt{class_name},
- model_file => $opt{model_file},
- voltage => {},
- };
-
- bless( $self, $class );
-
- my $class_name = $self->{class_name};
-
- my @states;
- my %transition;
-
- if ( not exists $repo->{class}{$class_name} ) {
- die("Unknown class: $class_name\n");
- }
- my $class_base = $repo->{class}{$class_name};
-
- for my $function ( values %{ $class_base->{function} } ) {
- my %param_values;
- for my $attrib ( @{ $function->{attributes} // [] } ) {
- if ( $attrib->{namespace} eq 'Model' ) {
- if ( $attrib->{name} =~ m{ ^ transition }x
- and @{ $attrib->{args} } == 2 )
- {
- push( @states, $attrib->{args}[0]{expression} );
- push( @states, $attrib->{args}[1]{expression} );
- push(
- @{ $transition{ $function->{name} }{src} },
- $attrib->{args}[0]{expression}
- );
- push(
- @{ $transition{ $function->{name} }{dst} },
- $attrib->{args}[1]{expression}
- );
- push(
- @{ $transition{ $function->{name} }{transitions} },
- [
- $attrib->{args}[0]{expression},
- $attrib->{args}[1]{expression}
- ]
- );
- }
- elsif ( $attrib->{name} =~ m{ ^ testval }x
- and @{ $attrib->{args} } == 2 )
- {
- push(
- @{ $param_values{ $attrib->{args}[0]{value} } },
- $attrib->{args}[1]{value}
- );
- }
- elsif (
- $attrib->{name} =~ m{ ^ required_in_ (?<state> .* ) $ }x )
- {
- push(
- @{
- $self->{custom_code}{after_transition_by_state}
- { $+{state} }
- },
- $function->{name}
- );
- }
- else {
- printf( "wat %s::%s\n",
- $attrib->{namespace}, $attrib->{name} );
- }
- }
- elsif ( $attrib =~ m{ ^ epilogue $ }x ) {
- $transition{ $function->{name} }{level} = 'epilogue';
- }
- else {
- printf( "wat %s::%s\n", $attrib->{namespace}, $attrib->{name} );
- }
- }
- if ( exists $transition{ $function->{name} } ) {
- for my $i ( 0 .. $#{ $function->{argtypes} } ) {
- my $argtype = $function->{argtypes}[$i];
- my $param_name = sprintf( '%s.arg%d', $function->{name}, $i );
- push(
- @{ $transition{ $function->{name} }{parameters} },
- {
- name => $param_name,
- values => $param_values{$i},
- }
- );
- $self->{parameter}{$param_name} = {
- arg_name => $param_name,
- function => $function->{name},
- default => undef,
- };
- }
- }
- }
-
- if ( exists $repo->{class}{"DriverEvalThread_${class_name}"} ) {
- for my $var (
- keys %{ $repo->{class}{"DriverEvalThread_${class_name}"}{variable} }
- )
- {
- if ( $var
- =~ m{ ^ testVal __ (?<fun> [^_]+ ) __ arg (?<index> \d+ ) __ (?<descr> [^_]+ ) $ }x
- )
- {
- push(
- @{
- $transition{ $+{fun} }{parameters}[ $+{index} ]{values}
- },
- $var
- );
- }
- }
- }
-
- @states = uniq @states;
- @states = sort @states;
-
- # by convention, UNINITIALIZED always has ID 0
- @states = grep { $_ ne 'UNINITIALIZED' } @states;
- unshift( @states, 'UNINITIALIZED' );
-
- for my $i ( 0 .. $#states ) {
- $self->{state}{ $states[$i] } = {
- id => $i,
- power => {
- static => 0,
- }
- };
- }
-
- my @transition_names = sort keys %transition;
-
- for my $i ( 0 .. $#transition_names ) {
-
- my $name = $transition_names[$i];
- my @origins = uniq @{ $transition{$name}{src} };
- my @destinations = uniq @{ $transition{$name}{dst} };
- my $guess_level = ( $name eq 'epilogue' ? 'epilogue' : 'user' );
-
- $self->{transition}{$name} = {
- name => $name,
- id => $i,
- destination => \@destinations,
- origins => \@origins,
- transitions => $transition{$name}{transitions},
- level => $transition{$name}{level} // $guess_level,
- parameters => $transition{$name}{parameters} // [],
- duration => { static => 0 },
- energy => { static => 0 },
- rel_energy_prev => { static => 0 },
- rel_energy_next => { static => 0 },
- timeout => { static => 0 },
- };
- if ( @destinations > 1 ) {
- my $dst_str = join( q{, }, @destinations );
- warn(
-"Transition ${name} has several destination states ($dst_str). This is only partially supported.\n"
- );
- }
- }
-
- write_file( $self->{model_file},
- JSON->new->pretty->encode( $self->TO_JSON ) );
-
- return $self;
-}
-
-sub reset_property {
- my ( $self, $hash, $name ) = @_;
-
- delete $hash->{$name}{static};
- if ( exists $hash->{$name}{function} ) {
- delete $hash->{$name}{function}{estimate};
- }
- if ( exists $hash->{$name}{function}{user} ) {
- $hash->{$name}{function}{user}{params}
- = [ map { 1 } @{ $hash->{$name}{function}{user}{params} } ];
- }
-}
-
-sub reset {
- my ($self) = @_;
-
- for my $state ( values %{ $self->{state} } ) {
- for my $property (qw(power)) {
- $self->reset_property( $state, $property );
- }
- }
-
- for my $transition ( $self->transitions ) {
- for my $property (
- qw(duration energy rel_energy_prev rel_energy_next timeout))
- {
- $self->reset_property( $transition, $property );
- }
- }
-}
-
-sub set_state_power {
- my ( $self, $state, $power ) = @_;
-
- $power = sprintf( '%.f', $power );
-
- printf( "state %-16s: adjust power %d -> %d µW\n",
- $state, $self->{state}{$state}{power}{static}, $power );
-
- $self->{state}{$state}{power}{static} = $power;
-}
-
-sub set_transition_property {
- my ( $self, $transition_name, $property, $value ) = @_;
-
- if ( not defined $value ) {
- return;
- }
-
- my $transition = $self->get_transition_by_name($transition_name);
-
- $value = sprintf( '%.f', $value );
-
- printf( "transition %-16s: adjust %s %d -> %d\n",
- $transition->{name}, $property, $transition->{$property}{static},
- $value );
-
- $transition->{$property}{static} = $value;
-}
-
-sub set_state_lut {
- my ( $self, $state, $property, $lut ) = @_;
-
- if ( not defined $lut ) {
- return;
- }
-
- ...;
-}
-
-sub set_transition_lut {
- my ( $self, $transition_name, $property, $lut ) = @_;
-
- if ( not defined $lut ) {
- return;
- }
-
- ...;
-}
-
-sub set_state_params {
- my ( $self, $state, $fun_name, $function, @params ) = @_;
- my $old_params = 'None';
-
- if ( exists $self->{state}{$state}{power}{function}{$fun_name} ) {
- $old_params = join( q{ },
- @{ $self->{state}{$state}{power}{function}{$fun_name}{params} } );
- }
-
- printf( "state %-16s: adjust %s power function parameters [%s] -> [%s]\n",
- $state, $fun_name, $old_params, join( q{ }, @params ) );
-
- $self->{state}{$state}{power}{function}{$fun_name}{raw} = $function;
- for my $i ( 0 .. $#params ) {
- $self->{state}{$state}{power}{function}{$fun_name}{params}[$i]
- = $params[$i];
- }
-}
-
-sub set_transition_params {
- my ( $self, $transition_name, $fun_type, $fun_name, $function, @params )
- = @_;
- my $transition = $self->get_transition_by_name($transition_name);
- my $old_params = 'None';
-
- if ( exists $transition->{$fun_type}{function}{$fun_name} ) {
- $old_params = join( q{ },
- @{ $transition->{$fun_type}{function}{$fun_name}{params} } );
- }
-
- printf( "transition %-16s: adjust %s %s function parameters [%s] -> [%s]\n",
- $transition_name, $fun_name, $fun_type, $old_params,
- join( q{ }, @params ) );
-
- $transition->{$fun_type}{function}{$fun_name}{raw} = $function;
- for my $i ( 0 .. $#params ) {
- $transition->{$fun_type}{function}{$fun_name}{params}[$i] = $params[$i];
- }
-}
-
-sub set_voltage {
- my ( $self, $min_voltage, $max_voltage ) = @_;
-
- $self->{voltage} = {
- min => $min_voltage,
- max => $max_voltage,
- };
-}
-
-sub save {
- my ($self) = @_;
-
- write_file( $self->{model_file},
- JSON->new->pretty->encode( $self->TO_JSON ) );
-}
-
-sub parameter_hash {
- my ($self) = @_;
-
- for my $param_name ( keys %{ $self->{parameter} } ) {
- $self->{parameter}{$param_name}{value}
- = $self->{parameter}{$param_name}{default};
- }
-
- return %{ $self->{parameter} };
-}
-
-sub update_parameter_hash {
- my ( $self, $param_hash, $function, @args ) = @_;
-
- my $transition = $self->get_transition_by_name($function);
-
- for my $param ( keys %{ $transition->{affects} } ) {
- $param_hash->{$param}{value} = $transition->{affects}{$param};
- }
-
- for my $i ( 0 .. $#args ) {
- my $arg_name = $transition->{parameters}[$i]{name};
- my $arg_value = $args[$i];
-
- for my $param_name ( keys %{ $self->{parameter} } ) {
- if ( $self->{parameter}{$param_name}{arg_name} eq $arg_name ) {
- $param_hash->{$param_name}{value} = $arg_value;
- }
- }
- }
-}
-
-sub startup_code {
- my ($self) = @_;
-
- return $self->{custom_code}{startup} // q{};
-}
-
-sub heap_code {
- my ($self) = @_;
-
- return $self->{custom_code}{heap} // q{};
-}
-
-sub after_transition_code {
- my ($self) = @_;
-
- return $self->{custom_code}{after_transition} // q{};
-}
-
-sub get_state_extra_transitions {
- my ( $self, $state ) = @_;
-
- return @{ $self->{custom_code}{after_transition_by_state}{$state} // [] };
-}
-
-sub shutdown_code {
- my ($self) = @_;
-
- return $self->{custom_code}{shutdown} // q{};
-}
-
-sub get_transition_by_name {
- my ( $self, $name ) = @_;
-
- return $self->{transition}{$name};
-}
-
-sub get_transition_by_id {
- my ( $self, $id ) = @_;
-
- my $transition = first { $_->{id} == $id } $self->transitions;
-
- return $transition;
-}
-
-sub get_state_id {
- my ( $self, $name ) = @_;
-
- return $self->{state}{$name}{id};
-}
-
-sub get_state_name {
- my ( $self, $id ) = @_;
-
- return ( $self->get_state_enum )[$id];
-}
-
-sub get_state_power {
- my ( $self, $name ) = @_;
-
- return $self->{state}{$name}{power}{static};
-}
-
-sub get_state_power_with_params {
- my ( $self, $name, $param_values ) = @_;
-
- my $hash_str = join( ';',
- map { $param_values->{$_} }
- sort { $a cmp $b } keys %{$param_values} );
-
- if ( $hash_str eq q{} ) {
- return $self->get_state_power($name);
- }
-
- if ( exists $self->{state}{$name}{power}{lut}{$hash_str} ) {
- return $self->{state}{$name}{power}{lut}{$hash_str};
- }
-
- say "Note: No matching LUT for state ${name}, using median";
-
- return $self->get_state_power($name);
-}
-
-sub get_state_enum {
- my ($self) = @_;
-
- if ( not exists $self->{state_enum} ) {
- @{ $self->{state_enum} }
- = sort { $self->{state}{$a}{id} <=> $self->{state}{$b}{id} }
- keys %{ $self->{state} };
- }
-
- return @{ $self->{state_enum} };
-}
-
-sub transitions {
- my ($self) = @_;
-
- my @ret = values %{ $self->{transition} };
- @ret = sort { $a->{id} <=> $b->{id} } @ret;
- return @ret;
-}
-
-sub TO_JSON {
- my ($self) = @_;
-
- return {
- class => $self->{class_name},
- parameter => $self->{parameter},
- state => $self->{state},
- transition => $self->{transition},
- custom_code => $self->{custom_code},
- voltage => $self->{voltage},
- };
-}
-
-1;
diff --git a/lib/MIMOSA.pm b/lib/MIMOSA.pm
deleted file mode 100644
index 54a5e15..0000000
--- a/lib/MIMOSA.pm
+++ /dev/null
@@ -1,177 +0,0 @@
-package MIMOSA;
-
-use strict;
-use warnings;
-use 5.020;
-
-use Carp;
-use Carp::Assert::More;
-use File::Slurp qw(read_dir);
-use IPC::Run qw(harness);
-use List::Util qw(max);
-
-our $VERSION = '0.00';
-
-sub new {
- my ( $class, %opt ) = @_;
-
- my $self = \%opt;
-
- bless( $self, $class );
-
- return $self;
-}
-
-sub start {
- my ($self) = @_;
- my $buf;
-
- my $mim_daemon = harness(
- [ 'MimosaCMD', '--start' ],
- '<' => \undef,
- '>&' => \$buf
- );
- my $mim_p1 = harness(
- [ 'MimosaCMD', '--parameter', 'offset', $self->{mimosa_offset} ],
- '<' => \undef,
- '>&' => \$buf
- );
- my $mim_p2 = harness(
- [ 'MimosaCMD', '--parameter', 'shunt', $self->{mimosa_shunt} ],
- '<' => \undef,
- '>&' => \$buf
- );
- my $mim_p3 = harness(
- [ 'MimosaCMD', '--parameter', 'voltage', $self->{mimosa_voltage} ],
- '<' => \undef,
- '>&' => \$buf
- );
- my $mim_p4 = harness(
- [ 'MimosaCMD', '--parameter', 'directory', 'src/apps/DriverEval' ],
- '<' => \undef,
- '>&' => \$buf
- );
- my $mim_start = harness(
- [ 'MimosaCMD', '--mimosa-start' ],
- '<' => \undef,
- '>&' => \$buf
- );
-
- if ( $self->is_running ) {
- croak("MIMOSA daemon is already running");
- }
-
- $mim_daemon->run or croak();
- $mim_p1->run or croak();
- $mim_p2->run or croak();
- $mim_p3->run or croak();
- $mim_start->run or croak();
-}
-
-sub is_running {
- my ($self) = @_;
-
- my $buf;
-
- my $mim_check = harness(
- [ 'pidof', 'MimosaCMD' ],
- '<' => \undef,
- '>&' => \$buf
- );
-
- return $mim_check->run;
-}
-
-sub stop {
- my ($self) = @_;
- my $buf;
-
- my $mim_stop = harness(
- [ 'MimosaCMD', '--mimosa-stop' ],
- '<' => \undef,
- '>&' => \$buf
- );
- my $mim_kill = harness(
- [ 'MimosaCMD', '--stop' ],
- '<' => \undef,
- '>&' => \$buf
- );
-
- # make sure MIMOSA has all teh data
- sleep(5);
-
- $mim_stop->run or croak();
-
- $self->wait_for_save;
-
- $mim_kill->run or croak();
-
- while ( $self->is_running ) {
- sleep(1);
- }
-}
-
-sub wait_for_save {
- my ($self) = @_;
-
- my $mtime = 0;
- my $mtime_changed = 1;
-
- while ($mtime_changed) {
- sleep(3);
- my @mim_files = grep { m{ \. mim $ }x } read_dir('.');
- my @mtimes = map { ( stat($_) )[9] } @mim_files;
- my $new_mtime = max @mtimes;
- if ( $new_mtime != $mtime ) {
- $mtime = $new_mtime;
- }
- else {
- $mtime_changed = 0;
- }
- }
-
- return $self;
-}
-
-sub kill {
- my ($self) = @_;
- my $buf;
-
- my $mim_kill = harness(
- [ 'MimosaCMD', '--stop' ],
- '<' => \undef,
- '>&' => \$buf
- );
-
- $mim_kill->run or croak();
-}
-
-sub calibrate {
- my ($self) = @_;
-
- $self->mimosactl('disconnect');
- sleep(2);
- $self->mimosactl('1k'); # actually 987 Ohm
- sleep(2);
- $self->mimosactl('100k'); # actually 99.3 kOhm
- sleep(2);
- $self->mimosactl('connect');
-}
-
-sub mimosactl {
- my ( $self, $arg ) = @_;
- my $buf;
-
- my $mimosactl = harness(
- [ 'mimosactl', $arg ],
- '<' => \undef,
- '>&' => \$buf
- );
-
- $mimosactl->run
- or croak( "mimosactl $arg returned " . $mimosactl->full_result );
-
- return $self;
-}
-
-1;
diff --git a/lib/MIMOSA/Log.pm b/lib/MIMOSA/Log.pm
deleted file mode 100644
index 270bbb2..0000000
--- a/lib/MIMOSA/Log.pm
+++ /dev/null
@@ -1,398 +0,0 @@
-package MIMOSA::Log;
-
-use strict;
-use warnings;
-use 5.020;
-
-use Archive::Tar;
-use Carp;
-use File::Slurp qw(read_file read_dir write_file);
-use JSON;
-use List::Util qw(sum);
-
-#use Statistics::Basic::Mean;
-#use Statistics::Basic::StdDev;
-
-our $VERSION = '0.00';
-my $CACHE_VERSION = 6;
-
-sub new {
- my ( $class, %opt ) = @_;
-
- my $self = \%opt;
-
- $self->{tmpdir} = "/tmp/kratos-dfa-mim-$$";
-
- if ( $opt{tmpsuffix} ) {
- $self->{tmpdir} .= "-$opt{tmpsuffix}";
- }
-
- bless( $self, $class );
-
- return $self;
-}
-
-sub tar {
- my ($self) = @_;
-
- $self->{tar} //= Archive::Tar->new( $self->{data_file} );
-
- return $self->{tar};
-}
-
-sub setup {
- my ($self) = @_;
-
- return $self->{setup};
-}
-
-sub load {
- return new(@_);
-}
-
-sub DESTROY {
- my ($self) = @_;
-
- if ( -d $self->{tmpdir} ) {
- for my $file ( read_dir( $self->{tmpdir} ) ) {
- unlink("$self->{tmpdir}/$file");
- }
- rmdir( $self->{tmpdir} );
- }
-}
-
-sub load_archive {
- my ($self) = @_;
-
- my $tmpdir = $self->{tmpdir};
-
- my @filelist = $self->tar->list_files;
- my @mim_files = sort grep { m{ \. mim $ }x } @filelist;
- my @json_files = map { ( split( qr{[.]}, $_ ) )[0] . '.json' } @mim_files;
-
- if ( $self->{fast_analysis} ) {
- splice( @mim_files, 4 );
- splice( @json_files, 4 );
- }
-
- $self->{filelist} = [@filelist];
- $self->{mim_files} = [@mim_files];
- $self->{mim_results} = [@json_files];
-
- $self->{log}{traces} = JSON->new->decode(
- $self->tar->get_content('src/apps/DriverEval/DriverLog.json') );
- $self->{setup} = JSON->new->decode( $self->tar->get_content('setup.json') );
-
- mkdir($tmpdir);
-
- for my $file (@mim_files) {
- $self->tar->extract_file( $file, "${tmpdir}/${file}" );
- }
-}
-
-sub load_cache {
- my ($self) = @_;
- my $tmpdir = $self->{tmpdir};
- my ( $dirname, $basename )
- = ( $self->{data_file} =~ m{ ^ (.*) / ([^/]+) . tar $ }x );
- my $cachefile = "${dirname}/cache/${basename}.json";
-
- if ( -e $cachefile ) {
- mkdir($tmpdir);
- write_file( $self->json_name, read_file($cachefile) );
- my $json = JSON->new->decode( read_file($cachefile) );
- if ( $json->{version} != $CACHE_VERSION ) {
- return 0;
- }
- $self->{setup} = $json->{setup};
- return 1;
- }
- return 0;
-}
-
-sub save_cache {
- my ($self) = @_;
- my $tmpdir = $self->{tmpdir};
- my ( $dirname, $basename )
- = ( $self->{data_file} =~ m{ ^ (.*) / ([^/]+) . tar $ }x );
- my $cachefile = "${dirname}/cache/${basename}.json";
-
- if ( not -d "${dirname}/cache" ) {
- mkdir("${dirname}/cache");
- }
-
- write_file( $cachefile, read_file( $self->json_name ) );
-}
-
-sub num_iterations {
- my ($self) = @_;
-
- return scalar @{ $self->{mim_files} };
-}
-
-sub sched_trigger_count {
- my ($self) = @_;
-
- if ( not $self->{sched_trigger_count} ) {
- $self->{sched_trigger_count} = 0;
- for my $run ( @{ $self->{log}{traces} } ) {
- $self->{sched_trigger_count} += @{ $run->{trace} };
- }
- }
-
- return $self->{sched_trigger_count};
-}
-
-sub merge {
- my ( $self, $file ) = @_;
-
- if ( not -e $file ) {
- return "Does not exist";
- }
-
- my $data = JSON->new->decode( read_file($file) );
- my $trig_count = $data->{triggers};
- if ( $self->sched_trigger_count != $trig_count ) {
- return sprintf( 'Expected %d trigger edges, got %d',
- $self->sched_trigger_count, $trig_count );
- }
-
- #printf("calibration check at: %.f±%.f %.f±%.f %.f±%.f\n",
- # $data->{calibration}{r0_mean},
- # $data->{calibration}{r0_std},
- # $data->{calibration}{r2_mean},
- # $data->{calibration}{r2_std},
- # $data->{calibration}{r1_mean},
- # $data->{calibration}{r1_std},
- #);
-
- # verify that state duration really is < 1.5 * setup{state_duration} and >
- # 0.5 * setup{state_duration}. otherwise we may have missed a trigger,
- # which wasn't detected earlier because of duplicate triggers elsewhere.
- my $data_idx = 0;
- for my $run ( @{ $self->{log}{traces} } ) {
- my $prev_elem = { name => q{} };
- for my $trace_elem ( @{ $run->{trace} } ) {
- my $log_elem = $data->{trace}[$data_idx];
- if ( $log_elem->{isa} eq 'state'
- and $trace_elem->{name} ne 'UNINITIALIZED'
- and $log_elem->{us} > $self->{setup}{state_duration} * 1500
- and $prev_elem->{name} ne 'txDone'
- and $prev_elem->{name} ne 'rxDone'
- and $prev_elem->{name} ne 'epilogue' )
- {
- return sprintf(
-'State %s (trigger index %d) took %.1f ms longer than expected',
- $trace_elem->{name},
- $data_idx,
- ( $log_elem->{us} / 1000 ) - $self->{setup}{state_duration}
- );
- }
- if ( $log_elem->{isa} eq 'state'
- and $trace_elem->{name} ne 'UNINITIALIZED'
- and $trace_elem->{name} ne 'TX'
- and $trace_elem->{name} ne 'RX'
- and $log_elem->{us} < $self->{setup}{state_duration} * 500 )
- {
- return sprintf(
-'State %s (trigger index %d) was %.1f ms shorter than expected',
- $trace_elem->{name},
- $data_idx,
- $self->{setup}{state_duration} - ( $log_elem->{us} / 1000 )
- );
- }
- $prev_elem = $trace_elem;
- $data_idx++;
- }
- }
-
- $data_idx = 0;
- for my $run ( @{ $self->{log}{traces} } ) {
- for my $trace_elem ( @{ $run->{trace} } ) {
- if ( $data->{trace}[$data_idx]{isa} ne $trace_elem->{isa} ) {
- croak();
- }
- delete $data->{trace}[$data_idx]{isa};
- push( @{ $trace_elem->{offline} }, $data->{trace}[$data_idx] );
- $data_idx++;
- }
- }
-
- push( @{ $self->{log}{calibration} }, $data->{calibration} );
-
- return;
-}
-
-sub preprocess {
- my ($self) = @_;
- my $tmpdir = $self->{tmpdir};
- my @files = @{ $self->{mim_files} };
- my $shunt = $self->{setup}{mimosa_shunt};
- my $voltage = $self->{setup}{mimosa_voltage};
- my @errmap;
-
- @files = map { "${tmpdir}/$_" } @files;
-
- if ( qx{parallel --version 2> /dev/null} =~ m{GNU parallel} ) {
- system( qw(parallel ../dfatool/bin/analyze.py),
- $voltage, $shunt, ':::', @files );
- }
- else {
- system( qw(parallel ../dfatool/bin/analyze.py),
- $voltage, $shunt, '--', @files );
- }
-
- for my $i ( 0 .. $#{ $self->{mim_results} } ) {
- my $file = $self->{mim_results}[$i];
- my $error = $self->merge("${tmpdir}/${file}");
-
- if ($error) {
- say "${file}: ${error}";
- push( @errmap, $i );
- }
- }
-
- if ( @errmap == @files ) {
- die("All MIMOSA measurements were erroneous. Aborting.\n");
- }
-
- $self->{log}{model} = $self->{model};
- $self->{log}{errmap} = \@errmap;
- $self->{log}{setup} = $self->{setup};
- $self->{log}{version} = $CACHE_VERSION;
- write_file( $self->json_name,
- JSON->new->convert_blessed->encode( $self->{log} ) );
-}
-
-sub analyze {
- my ( $self, @extra_files ) = @_;
- my $tmpdir = $self->{tmpdir};
-
- @extra_files = grep { $_ ne $self->json_name } @extra_files;
-
- for my $file ( $self->json_name, @extra_files ) {
- my $json = JSON->new->decode( read_file($file) );
- $json->{model} = $self->{model};
-
-# fix for incomplete json files: transitions can also depend on global parameters
- for my $run ( @{ $json->{traces} } ) {
- for my $i ( 0 .. $#{ $run->{trace} } ) {
- $run->{trace}[$i]{parameter}
- //= $run->{trace}[ $i - 1 ]{parameter};
- }
- }
-
- write_file( $file, JSON->new->convert_blessed->encode($json) );
- }
-
- system( '../dfatool/bin/merge.py', @{ $self->{merge_args} // [] },
- $self->json_name, @extra_files );
-
- my $json = JSON->new->decode( read_file( $self->json_name ) );
-
- $self->{aggregate} = $json->{aggregate};
-
- # debug
- write_file( "/tmp/DriverLog.json", JSON->new->pretty->encode($json) );
-}
-
-sub validate {
- my ( $self, @extra_files ) = @_;
- my $tmpdir = $self->{tmpdir};
-
- @extra_files = grep { $_ ne $self->json_name } @extra_files;
-
- for my $file ( $self->json_name, @extra_files ) {
- my $json = JSON->new->decode( read_file($file) );
- $json->{model} = $self->{model};
- my @errmap = @{ $json->{errmap} // [] };
-
-# fix for incomplete json files: transitions can also depend on global parameters
- for my $run ( @{ $json->{traces} } ) {
- for my $i ( 0 .. $#{ $run->{trace} } ) {
- $run->{trace}[$i]{parameter}
- //= $run->{trace}[ $i - 1 ]{parameter};
- }
- }
-
- # online durations count current state + next transition, but we
- # only want to analyze current state -> substract next transition.
- # Note that we can only do this on online data which has
- # corresponding offline data, i.e. where the offline data was not
- # erroneous
- for my $run ( @{ $json->{traces} } ) {
- if ( exists $run->{total_energy} ) {
-
- # splice changes the array (and thus the indices). so we need to
- # start removing elements at the end
- for my $erridx ( reverse @errmap ) {
- splice( @{ $run->{total_energy} }, $erridx, 1 );
- }
- }
- for my $i ( 0 .. $#{ $run->{trace} } ) {
- for my $erridx ( reverse @errmap ) {
- splice( @{ $run->{trace}[$i]{online} }, $erridx, 1 );
- }
- if ( $run->{trace}[$i]{isa} eq 'state' ) {
- for my $j ( 0 .. $#{ $run->{trace}[$i]{online} } ) {
- $run->{trace}[$i]{online}[$j]{time}
- -= $run->{trace}[ $i + 1 ]{offline}[$j]{us};
- }
- }
- }
- }
-
- write_file( $file, JSON->new->convert_blessed->encode($json) );
- }
-
- system( '../dfatool/bin/merge.py', @{ $self->{merge_args} // [] },
- '--validate', $self->json_name, @extra_files );
-
- my $json = JSON->new->decode( read_file( $self->json_name ) );
-
- $self->{aggregate} = $json->{aggregate};
-
- # debug
- write_file( "/tmp/DriverLog.json", JSON->new->pretty->encode($json) );
-}
-
-sub crossvalidate {
- my ( $self, @extra_files ) = @_;
- my $tmpdir = $self->{tmpdir};
-
- @extra_files = grep { $_ ne $self->json_name } @extra_files;
-
- for my $file ( $self->json_name, @extra_files ) {
- my $json = JSON->new->decode( read_file($file) );
- $json->{model} = $self->{model};
-
-# fix for incomplete json files: transitions can also depend on global parameters
- for my $run ( @{ $json->{traces} } ) {
- for my $i ( 0 .. $#{ $run->{trace} } ) {
- $run->{trace}[$i]{parameter}
- //= $run->{trace}[ $i - 1 ]{parameter};
- }
- }
-
- write_file( $file, JSON->new->convert_blessed->encode($json) );
- }
-
- system( '../dfatool/bin/merge.py', @{ $self->{merge_args} // [] },
- '--crossvalidate', $self->json_name, @extra_files );
-}
-
-sub data {
- my ($self) = @_;
- my $tmpdir = $self->{tmpdir};
- my $json = JSON->new->decode( read_file( $self->json_name ) );
- return $json;
-}
-
-sub json_name {
- my ($self) = @_;
- my $tmpdir = $self->{tmpdir};
-
- return "${tmpdir}/DriverLog.json";
-}
-
-1;
diff --git a/lib/Math/Cartesian/Product.pm b/lib/Math/Cartesian/Product.pm
deleted file mode 100644
index eedcf1e..0000000
--- a/lib/Math/Cartesian/Product.pm
+++ /dev/null
@@ -1,262 +0,0 @@
-=head1 Name
-
-Math::Cartesian::Product - Generate the Cartesian product of zero or more lists.
-
-=head1 Synopsis
-
- use Math::Cartesian::Product;
-
- cartesian {print "@_\n"} [qw(a b c)], [1..2];
-
- # a 1
- # a 2
- # b 1
- # b 2
- # c 1
- # c 2
-
- cartesian {print "@_\n"} ([0..1]) x 8;
-
- # 0 0 0 0 0 0 0 0
- # 0 0 0 0 0 0 0 1
- # 0 0 0 0 0 0 1 0
- # ...
- # 1 1 1 1 1 1 1 0
- # 1 1 1 1 1 1 1 1
-
- print "@$_\n" for
- cartesian {"@{[reverse @_]}" eq "@_"}
- ([' ', '*']) x 8;
-
- # * *
- # * *
- # * * * *
- # * *
- # * * * *
- # * * * *
- # * * * * * *
- # * *
- # * * * *
- # * * * *
- # * * * * * *
- # * * * *
- # * * * * * *
- # * * * * * *
- # * * * * * * * *
-
-=cut
-
-package Math::Cartesian::Product;
-
-use Carp;
-use strict;
-
-sub cartesian(&@) # Generate the Cartesian product of zero or more lists
- {my $s = shift; # Subroutine to call to process each element of the product
-
- my @C = @_; # Lists to be multiplied
- my @c = (); # Current element of Cartesian product
- my @P = (); # Cartesian product
- my $n = 0; # Number of elements in product
-
-# return 0 if @C == 0; # Empty product per Philipp Rumpf
-
- @C == grep {ref eq 'ARRAY'} @C or croak("Arrays of things required by cartesian");
-
-# Generate each Cartesian product when there are no prior Cartesian products.
-# The first variant builds the results array, the second does not per Justin Case
-
- my $p; $p = wantarray() ? sub
- {if (@c < @C)
- {for(@{$C[@c]})
- {push @c, $_;
- &$p();
- pop @c;
- }
- }
- else
- {my $p = [@c];
- push @P, bless $p if &$s(@$p);
- }
- } : sub # List not required per Justin Case
- {if (@c < @C)
- {for(@{$C[@c]})
- {push @c, $_;
- &$p();
- pop @c;
- }
- }
- else
- {++$n if &$s(@c);
- }
- };
-
-# Generate each Cartesian product allowing for prior Cartesian products.
-
- my $q; $q = wantarray() ? sub
- {if (@c < @C)
- {for(@{$C[@c]})
- {push @c, $_;
- &$q();
- pop @c;
- }
- }
- else
- {my $p = [map {ref eq __PACKAGE__ ? @$_ : $_} @c];
- push @P, bless $p if &$s(@$p);
- }
- } : sub # List not required per Justin Case
- {if (@c < @C)
- {for(@{$C[@c]})
- {push @c, $_;
- &$q();
- pop @c;
- }
- }
- else
- {++$n if &$s(map {ref eq __PACKAGE__ ? @$_ : $_} @c);
- }
- };
-
-# Determine optimal method of forming Cartesian products for this call
-
- if (grep {grep {ref eq __PACKAGE__} @$_} @C)
- {&$q
- }
- else
- {&$p
- }
-
- $p = $q = undef; # Break memory loops per Philipp Rumpf
- wantarray() ? @P : $n # Product or count per Justin Case
- }
-
-# Export details
-
-require 5;
-require Exporter;
-
-use vars qw(@ISA @EXPORT $VERSION);
-
-@ISA = qw(Exporter);
-@EXPORT = qw(cartesian);
-$VERSION = '1.009'; # Tuesday 18 Aug 2015
-
-=head1 Description
-
-Generate the Cartesian product of zero or more lists.
-
-Given two lists, say: [a,b] and [1,2,3], the Cartesian product is the
-set of all ordered pairs:
-
- (a,1), (a,2), (a,3), (b,1), (b,2), (b,3)
-
-which select their first element from all the possibilities listed in
-the first list, and select their second element from all the
-possibilities in the second list.
-
-The idea can be generalized to n-tuples selected from n lists where all the
-elements of the first list are combined with all the elements of the second
-list, the results of which are then combined with all the member of the third
-list and so on over all the input lists.
-
-It should be noted that Cartesian product of one or more lists where one or
-more of the lists are empty (representing the empty set) is the empty set
-and thus has zero members; and that the Cartesian product of zero lists is a
-set with exactly one member, namely the empty set.
-
-C<cartesian()> takes the following parameters:
-
-1. A block of code to process each n-tuple. this code should return true
-if the current n-tuple should be included in the returned value of the
-C<cartesian()> function, otherwise false.
-
-2. Zero or more lists.
-
-C<cartesian()> returns an array of references to all the n-tuples selected by
-the code block supplied as parameter 1 if called in list context, else it
-returns a count of the selected n-tuples.
-
-C<cartesian()> croaks if you try to form the Cartesian product of
-something other than lists of things or prior Cartesian products.
-
-The cartesian product of lists A,B,C is associative, that is:
-
- (A X B) X C = A X (B X C)
-
-C<cartesian()> respects associativity by allowing you to include a
-Cartesian product produced by an earlier call to C<cartesian()> in the
-set of lists whose Cartesian product is to be formed, at the cost of a
-performance penalty if this option is chosen.
-
- use Math::Cartesian::Product;
-
- my $a = [qw(a b)];
- my $b = [cartesian {1} $a, $a];
- cartesian {print "@_\n"} $b, $b;
-
- # a a a a
- # a a a b
- # a a b a
- # ...
-
-C<cartesian()> is easy to use and fast. It is written in 100% Pure Perl.
-
-=head1 Export
-
-The C<cartesian()> function is exported.
-
-=head1 Installation
-
-Standard Module::Build process for building and installing modules:
-
- perl Build.PL
- ./Build
- ./Build test
- ./Build install
-
-Or, if you're on a platform (like DOS or Windows) that doesn't require
-the "./" notation, you can do this:
-
- perl Build.PL
- Build
- Build test
- Build install
-
-=head1 Author
-
-Philip R Brenan at gmail dot com
-
-http://www.appaapps.com
-
-=head1 Acknowledgements
-
-With much help and good natured advice from Philipp Rumpf and Justin Case to
-whom I am indebted.
-
-=head1 See Also
-
-=over
-
-=item L<Math::Disarrange::List>
-
-=item L<Math::Permute::List>
-
-=item L<Math::Permute::Lists>
-
-=item L<Math::Permute::Partitions>
-
-=item L<Math::Subsets::List>
-
-=item L<Math::Transform::List>
-
-=back
-
-=head1 Copyright
-
-Copyright (c) 2009-2015 Philip R Brenan.
-
-This module is free software. It may be used, redistributed and/or
-modified under the same terms as Perl itself.
-
-=cut
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-21 20:24:25 +0000