diff --git a/mindreadtestff.pl b/mindreadtestff.pl deleted file mode 100644 index c0dddda..0000000 --- a/mindreadtestff.pl +++ /dev/null @@ -1,69 +0,0 @@ -%% Won't work because tests a computation, not mind reads - -%% mind read test - -%% Make files different for different tests - -/** -1. Breason out 250 br A - as receiver/idea -2. Time this for A for the topic breasoned out and not breasoned out at random intervals for an interval of time (not to do with the random intervals), person to me -3. Does it take considerably longer for detected As? - calculate median of mostly hopefully false trials and differences from it x labelled graph first - do 10 trials over 10 minutes with 3 hopefully successful attempts that are labelled - -In addition to 250s for mindreadtestobj and mindreadtestlang, 250s for quarter master and object bo-x left right front back top bottom protection and off (18 250s) - -**/ - -%%use_module(library(pio)). - -:- use_module(library(date)). -:- include('texttobr2qb'). - -sectest:- - get_time(TS),stamp_date_time(TS,T,local),writeln([dateandtime,T]), - trialy2("2-3=6"), - trialy2("2+3=6"), - trialy2("2*3=6"), - trialy2("2/3=6"), - trialy2("2^3=6"). - -trialy2(Label) :- - writeln([testing,Label]), - trialy1(R1), - trialy1(R2), - trialy1(R3), - R=[R1,R2,R3], - (member(true,R)->(aggregate_all(count, member(true,R), Count),writeln([Label,Count,"/3"]));true). - -trialy1(R1) :- - trial0(A1), %% Control - trial0(A2), %% Test 1 - (A1>A2->R1=true;R1=fail). - -trial0(Av) :- N is 10, trial1(N,0,S), - Av is S/N. - -trial1(0,A,A) :- !. -trial1(N,A,B) :- mindreadtest(S), A1 is A+S, - N1 is N-1,trial1(N1,A1,B). - -mindreadtest(Sec) :- - %% 250 br for characters to be br out with 10 br each from person to me - do when initial 250 br test done and doing 10 br test - %%comment(fiftyastest), - %%random(X),X1 is 10*X, X2 is floor(X1), (X2=<2 -> ( - %%texttobr,writeln(['true test']), %%); %% use breasonings breasoned out by computer for not by me, for job medicine for "me", at last time point - %%true), %% leave last time point blank - get_time(TimeStamp1), - %%phrase_from_file(string(_String), 'file.txt'), - texttobr2, %% test breasonings breasoned out by computer for not by me, for job medicine for "me", at last time point - get_time(TimeStamp2), - %%comment(turnoffas), - Sec is TimeStamp2 - TimeStamp1. - -/**string(String) --> list(String). - -list([]) --> []. -list([L|Ls]) --> [L], list(Ls). - -comment(fiftyastest). -comment(turnoffas). -**/ \ No newline at end of file diff --git a/mindreadtestlang-1.pl b/mindreadtestlang-1.pl deleted file mode 100644 index 6d54939..0000000 --- a/mindreadtestlang-1.pl +++ /dev/null @@ -1,117 +0,0 @@ -%% mind read test - -%% Make files different for different tests - -/** -1. Breason out 250 br A - as receiver/idea -2. Time this for A for the topic breasoned out and not breasoned out at random intervals for an interval of time (not to do with the random intervals), person to me -3. Does it take considerably longer for detected As? - calculate median of mostly hopefully false trials and differences from it x labelled graph first - do 10 trials over 10 minutes with 3 hopefully successful attempts that are labelled - -In addition to mindreadtestobj 250s, do 250 bos for front, behind, above and below, protection and off for each one - -every 0.1 s wuc/mnws? New Recording 6.m4a "...lo I'm Lucian" - -x: (too difficult because letters are not words - focus on objects) - -- combine with objects x make interval much shorter, repeat - -**/ - -%%use_module(library(pio)). - -:- use_module(library(date)). -:- include('texttobr2qb'). - -sectest0 :- -repeat,sectest,sectest0. -sectest:- - get_time(TS),stamp_date_time(TS,T,local),writeln([dateandtime,T]), - %% worked well with abc out of 10 - trialy2("a",R1), - trialy2("b",R2), - trialy2("c",R3), - trialy2("d",R4), - trialy2("e",R5),/** - trialy2("f",R6), - trialy2("g",R7), - trialy2("h",R8), - trialy2("i",R9), - trialy2("j",R10), - trialy2("k",R11), - trialy2("l",R12), - trialy2("m",R13), - trialy2("n",R14), - trialy2("o",R15), - trialy2("p",R16), - trialy2("q",R17), - trialy2("r",R18), - trialy2("s",R19), - trialy2("t",R20), - trialy2("u",R21), - trialy2("v",R22), - trialy2("w",R23), - trialy2("x",R24), - trialy2("y",R25), - trialy2("z",R26), - trialy2(" ",R27),**/ - R=[R1,R2,R3,R4,R5/**,R6,R7,R8,R9,R10,R11,R12,R13,R14,R15,R16,R17,R18,R19,R20,R21,R22,R23,R24,R25,R26,R27**/ - ], - sort(R,RA), - reverse(RA,RB), - RB=[[_,_Item]|_Rest],writeln(RB),read_string(user_input,1,_).%%writeln(RB). - -trialy2(Label,RA) :- - %%writeln([testing,Label]), - trialy1(R1), - trialy1(R2), - trialy1(R3), - trialy1(R4), - trialy1(R5), - trialy1(R6), - trialy1(R7), - trialy1(R8), - trialy1(R9), - trialy1(R10), - trialy1(R11), - trialy1(R12), - trialy1(R13), - trialy1(R14), - trialy1(R15),/****/ - R=[R1,R2,R3,R4,R5,R6,R7,R8,R9,R10,R11,R12,R13,R14,R15],%%,], - %%(member(true,R)->( - aggregate_all(count, member(true,R), Count), - RA=[Count,Label].%%,writeln([Label,Count,"/10"]));true). - -trialy1(R1) :- - trial0(A1), %% Control - trial0(A2), %% Test 1 - (A1>A2->R1=true;R1=fail). - -trial0(Av) :- N is 10, trial1(N,0,S), - Av is S/N. - -trial1(0,A,A) :- !. -trial1(N,A,B) :- mindreadtest(S), A1 is A+S, - N1 is N-1,trial1(N1,A1,B). - -mindreadtest(Sec) :- - %% 250 br for characters to be br out with 10 br each from person to me - do when initial 250 br test done and doing 10 br test - %%comment(fiftyastest), - %%random(X),X1 is 10*X, X2 is floor(X1), (X2=<2 -> ( - %%texttobr,writeln(['true test']), %%); %% use breasonings breasoned out by computer for not by me, for job medicine for "me", at last time point - %%true), %% leave last time point blank - get_time(TimeStamp1), - %%phrase_from_file(string(_String), 'file.txt'), - texttobr2, %% test breasonings breasoned out by computer for not by me, for job medicine for "me", at last time point - get_time(TimeStamp2), - %%comment(turnoffas), - Sec is TimeStamp2 - TimeStamp1. - -/**string(String) --> list(String). - -list([]) --> []. -list([L|Ls]) --> [L], list(Ls). - -comment(fiftyastest). -comment(turnoffas). -**/ \ No newline at end of file diff --git a/mindreadtestlang.pl b/mindreadtestlang.pl deleted file mode 100644 index bab96e2..0000000 --- a/mindreadtestlang.pl +++ /dev/null @@ -1,99 +0,0 @@ -%% mindreadtestlang-done 250s for vps, local - -%% mind read test - -%% Make files different for different tests - -/** -1. Breason out 250 br A - as receiver/idea -2. Time this for A for the topic breasoned out and not breasoned out at random intervals for an interval of time (not to do with the random intervals), person to me -3. Does it take considerably longer for detected As? - calculate median of mostly hopefully false trials and differences from it x labelled graph first - do 10 trials over 10 minutes with 3 hopefully successful attempts that are labelled - -In addition to mindreadtestobj 250s, do 250 bos for front, behind, above and below, protection and off for each one - -every 0.1 s wuc/mnws? New Recording 6.m4a "...lo I'm Lucian" - -x: (too difficult because letters are not words - focus on objects) - -- combine with objects x make interval much shorter, repeat - -**/ - -%%use_module(library(pio)). - -:- use_module(library(date)). -:- include('texttobr2qb'). - -sectest0 :- -repeat,sectest,sectest0. -sectest:- - find("letter",_L),%%writeln(L), - read_string(user_input,1,_). - -findbest(R,Item):- - sort(R,RA), - reverse(RA,RB), - RB=[[_,Item]|_Rest],writeln(RB). - -find("letter",Item1) :- - trialy2([a,b,c,d,e%%,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,' ' - ],R), %% 0 is 0->1 etc. - findbest(R,Item1). - -trialy2(List,R) :- - %%length(List,L), - Trials is 15,%%L+3, - trialy22(List,Trials,[],R). - -trialy22([],_,R,R) :- !. -trialy22(List,Trials,RA,RB) :- - List=[Item|Items], - trialy21(Item,Trials,R1), - append(RA,[R1],RC), - trialy22(Items,Trials,RC,RB),!. - -trialy21(Label,Trials,RA) :- - trialy3(Trials,[],R), - aggregate_all(count, member(true,R), Count), - RA=[Count,Label]. - -trialy3(0,R,R) :-!. -trialy3(Trials1,RA,RB) :- - trialy1(R1), - append(RA,[R1],RC), - Trials2 is Trials1-1, - trialy3(Trials2,RC,RB),!. - -trialy1(R1) :- - trial0(A1), %% Control - trial0(A2), %% Test 1 - (A1>A2->R1=true;R1=fail). - -trial0(Av) :- N is 10, trial1(N,0,S), - Av is S/N. - -trial1(0,A,A) :- !. -trial1(N,A,B) :- mindreadtest(S), A1 is A+S, - N1 is N-1,trial1(N1,A1,B). - -mindreadtest(Sec) :- - %% 250 br for characters to be br out with 10 br each from person to me - do when initial 250 br test done and doing 10 br test - %%comment(fiftyastest), - %%random(X),X1 is 10*X, X2 is floor(X1), (X2=<2 -> ( - %%texttobr,writeln(['true test']), %%); %% use breasonings breasoned out by computer for not by me, for job medicine for "me", at last time point - %%true), %% leave last time point blank - get_time(TimeStamp1), - %%phrase_from_file(string(_String), 'file.txt'), - texttobr2, %% test breasonings breasoned out by computer for not by me, for job medicine for "me", at last time point - get_time(TimeStamp2), - %%comment(turnoffas), - Sec is TimeStamp2 - TimeStamp1. - -/**string(String) --> list(String). - -list([]) --> []. -list([L|Ls]) --> [L], list(Ls). - -comment(fiftyastest). -comment(turnoffas). -**/ \ No newline at end of file diff --git a/mindreadtestmeditation.pl b/mindreadtestmeditation.pl deleted file mode 100644 index 3f9d266..0000000 --- a/mindreadtestmeditation.pl +++ /dev/null @@ -1,152 +0,0 @@ -%% mind read test - -%% Make files different for different tests - -/** -1. Breason out 250 br A - as receiver/idea -2. Time this for A for the topic breasoned out and not breasoned out at random intervals for an interval of time (not to do with the random intervals), person to me -3. Does it take considerably longer for detected As? - calculate median of mostly hopefully false trials and differences from it x labelled graph first - do 10 trials over 10 minutes with 3 hopefully successful attempts that are labelled - -[dateandtime,date(2019,4,27,10,28,25.09528613090515,0,UTC,false)] -[[*5,lorelle],[5,dam],[5,adrian],[4,water],[4,seed],[2,redblackduck]] -lorelle but after start - -[dateandtime,date(2019,4,27,10,28,50.22005605697632,0,UTC,false)] -[[8,seed],[6,redblackduck],[*4,dam],[3,water],[3,adrian],[1,lorelle]] -dam - -[dateandtime,date(2019,4,27,10,29,13.600827693939209,0,UTC,false)] -[[*7,redblackduck],[7,lorelle],[6,dam],[5,seed],[3,water],[3,adrian]] -red black duck after start - -[dateandtime,date(2019,4,27,10,29,37.128156661987305,0,UTC,false)] -[[6,seed],[6,dam],[5,water],[*5,redblackduck],[4,adrian],[3,lorelle]] -red black duck - -[dateandtime,date(2019,4,27,10,30,1.5190646648406982,0,UTC,false)] -[[9,adrian],[*8,redblackduck],[7,dam],[6,seed],[5,water],[4,lorelle]] -red black duck - -Is it detecting what I am really thinking (or someone else) are the thoughts intertwined - all x - -I seem to have really thought about 1. the main character 2. the reason 3. the next character 4. what was later 5. who would put them away - -Is the seen as version able to be used? Is it a stream of consciousness detector? - -***250s for dotting yourself on speaking and dotting yourself receiving, and yourself speaking and yourself receiving (each day?) - - -[dateandtime,date(2019,4,27,11,5,29.561346292495728,0,UTC,false)] -[[7,seed],[7,adrian],[*6,water],[6,lorelle],[6,dam],[4,redblackduck]] -water -[dateandtime,date(2019,4,27,11,5,53.5652551651001,0,UTC,false)] -[[7,seed],[*6,water],[6,dam],[5,lorelle],[3,redblackduck],[2,adrian]] -water - -[dateandtime,date(2019,4,27,11,6,17.240721464157104,0,UTC,false)] -[[*6,dam],[5,redblackduck],[5,adrian],[4,water],[4,seed],[3,lorelle]] -dam - -[dateandtime,date(2019,4,27,11,6,41.15016746520996,0,UTC,false)] -[[7,redblackduck],[7,lorelle],[*7,dam],[6,adrian],[3,water],[3,seed]] -dam - -*** think to binary opposition x objects to either side - just do 250s for l,r, then turn off with a 250 - -*** put back positive protective thoughts on top, just do 250, then turn off with 250 - -working ok - -**/ - -%%use_module(library(pio)). - -:- use_module(library(date)). -:- include('texttobr2qb'). -:- include('mindreadtestshared'). - -sectest(Person):- - daysbspeoplearmy, %% dot me on - daysbspeoplearmy, %% dot them on - find_time(H,M,S), - daysbspeoplearmy, %% dot question on - comment(Comment), - daysbspeoplearmy, %% dot answer on - writeln([Person,H,M,S,Comment]). - -comment(Comment):- - trialy2_30("I like it here.",R1), - trialy2_30("1 want to go somewhere else.",R2), - trialy2_30("I feel sleepy.",R3), - trialy2_30("I feel fun.",R4), - trialy2_30("I feel good.",R5), - trialy2_30("I feel smart.",R6), - trialy2_30("I feel ambitious.",R7), - trialy2_30("I feel hungry.",R8), - trialy2_30("Other.",R9), - trialy2_30("I like one of Lucian's programs.",R10), - R=[R1,R2,R3,R4,R5,R6,R7,R8,R9,R10/**,R11,R12,R13,R14,R15,R16,R17,R18,R19,R20,R21,R22,R23,R24,R25,R26,R27**/ - ], - sort(R,RA), - reverse(RA,RB), - RB=[[_,Comment1]|_Rest], - - (Comment1="I like one of Lucian's programs."->(comment2(Comment2),comment2(Comment3),Comment=[Comment3,about,Comment2]);Comment=Comment1). - -comment2(Comment):- - trialy2_30("Character Breasoner",R1), - trialy2_30("1451",R2), - trialy2_30("1564",R3), - trialy2_30("1645",R4), - trialy2_30("Classical Music Chord Progression Composition",R5), - trialy2_30("Texttobr",R6), - trialy2_30("Texttobr2",R7), - trialy2_30("Daily Regimen: Medicine",R8), - trialy2_30("Daily Regimen: Meditation",R9), - trialy2_30("List Prolog Interpreter",R10),/** - trialy2("Updater",R11), - trialy2("Program Finder",R12), - trialy2("CAW",R13), - trialy2("RCAW",R14), - trialy2("Grammar",R15), - trialy2("CTT",R16),**/ R=[R1,R2,R3,R4,R5,R6,R7,R8,R9,R10/**,R11,R12,R13,R14,R15,R16,R17,R18,R19,R20,R21,R22,R23,R24,R25,R26,R27**/ - ], - sort(R,RA), - reverse(RA,RB), - RB=[[_,Comment]|_Rest]. - -trialy1(R1) :- - trial0(A1), %% Control - trial0(A2), %% Test 1 - (A1>A2->R1=true;R1=fail). - -trial0(Av) :- N is 10, trial1(N,0,S), - Av is S/N. - -trial1(0,A,A) :- !. -trial1(N,A,B) :- mindreadtest(S), A1 is A+S, - N1 is N-1,trial1(N1,A1,B). - -mindreadtest(Sec) :- - %% 250 br for characters to be br out with 10 br each from person to me - do when initial 250 br test done and doing 10 br test - %%comment(fiftyastest), - %%random(X),X1 is 10*X, X2 is floor(X1), (X2=<2 -> ( - %%texttobr,writeln(['true test']), %%); %% use breasonings breasoned out by computer for not by me, for job medicine for "me", at last time point - %%true), %% leave last time point blank - (texttobr2(2)),%% make an A to detect reaction to gracious giving or blame of in following - get_time(TimeStamp1), - %%phrase_from_file(string(_String), 'file.txt'), - (daysbspeoplearmy(2)), %% test breasonings breasoned out by computer for not by me, for job medicine for "me", at last time point - %% is gracious giving or blame - get_time(TimeStamp2), - %%comment(turnoffas), - Sec is TimeStamp2 - TimeStamp1. - -/**string(String) --> list(String). - -list([]) --> []. -list([L|Ls]) --> [L], list(Ls). - -comment(fiftyastest). -comment(turnoffas). -**/ \ No newline at end of file diff --git a/mindreadtestobj-12scrn-2.pl b/mindreadtestobj-12scrn-2.pl index 359e76d..62f723c 100644 --- a/mindreadtestobj-12scrn-2.pl +++ b/mindreadtestobj-12scrn-2.pl @@ -1,7 +1,8 @@ %% mindreadtestobj-12scrn.pl -%% N is 2*2*3*6,texttobr2(N). %% 100 As for 2 (turned on then off)*2 (to and from computer)*3 (rb, itself (already done), graciously give or blame, radio button for graciously give or blame)*6 (6 objects) -%% then texttobr2(40).to turn off these with 250s before start - also breason out and dot on objects before line above and breason out and dot on when recognising and saying object (with all objects having different breasonings) +%% *** Important: initialise program before running for the first time: +%% N is 2*2*3*5,texttobr2(N). %% 100 As for 2 (turned on then off)*2 (to and from computer)*3 (rb, itself (already done), graciously give or blame, radio button for graciously give or blame)*5 (5 objects) +%% also breason out and dot on objects before line above and breason out and dot on when recognising and saying object (with all objects having different breasonings) %% to recognise, think of stream of consciousness breasonings, the appearance of an object, words appearing and tricky appearances that mean something else @@ -25,31 +26,11 @@ :- include('mindreadtestshared'). :- include('texttobr2qb'). -daysbspeoplearmy:- - daysbspeoplearmy(45), - daysbspeoplearmy(2). %% Give to people with radio graciously give or blame, radio button for graciously give or blame - -daysbspeoplearmy(0):-!. -daysbspeoplearmy(N1):- - texttobr2,N2 is N1-1,daysbspeoplearmy(N2). - -/** -control1:- - retractall(control11(_)), - writeln("Think of nothing for the next second"), - sleep(1), - trial0(A1), %% control1 - sleep(5), - sum(A1,0,S02), - mean(S02,A2), - assertz(control11(A2)). -**/ %%sectest0 :- %%repeat,sectest,sectest0. sectest(S) :- sectest(7,0,S). sectest(0,S,S):-!. sectest(N,S1,S2):- - %%control1, writeln(["The computer will think of one of the following thoughts when I let you know."]), texttobr2(2), %% for 100 As for screen to display white background texttobr2(2), %% for 100 As for screen to display A @@ -104,33 +85,11 @@ %% Test thought here. %%writeln(["Now"]), %%get_time(TS),stamp_date_time(TS,T,local),writeln([dateandtime,T]), - trialy2("seed",R1), - trialy2("water",R2), - trialy2("dam",R3), - trialy2("redblackduck",R4), - trialy2("lorelle",R5), - /**trialy2("adrian",R6), - trialy2("g",R7), - trialy2("h",R8), - trialy2("i",R9), - trialy2("j",R10), - trialy2("k",R11), - trialy2("l",R12), - trialy2("m",R13), - trialy2("n",R14), - trialy2("o",R15), - trialy2("p",R16), - trialy2("q",R17), - trialy2("r",R18), - trialy2("s",R19), - trialy2("t",R20), - trialy2("u",R21), - trialy2("v",R22), - trialy2("w",R23), - trialy2("x",R24), - trialy2("y",R25), - trialy2("z",R26), - trialy2(" ",R27),**/ + trialy2_15("seed",R1), + trialy2_15("water",R2), + trialy2_15("dam",R3), + trialy2_15("redblackduck",R4), + trialy2_15("lorelle",R5), R=[R1,R2,R3,R4,R5],%%,R6,R7,R8,R9,R10,R11,R12,R13,R14,R15,R16,R17,R18,R19,R20,R21,R22,R23,R24,R25,R26,R27], sort(R,RA), reverse(RA,RB), @@ -141,115 +100,3 @@ N1 is N-1,(A=Item->S3 is S1+1;S3=S1), sectest(N1,S3,S2). %%read_string(user_input,1,_). - -trialy2(Label,RA) :- - %%writeln([testing,Label]), - trialy1(R1), - trialy1(R2), - trialy1(R3), - trialy1(R4), - trialy1(R5), - trialy1(R6), - trialy1(R7), - trialy1(R8), - trialy1(R9), - trialy1(R10), - trialy1(R11), - trialy1(R12), - trialy1(R13), - trialy1(R14), - trialy1(R15), - R=[R1,R2,R3,R4,R5,R6,R7,R8,R9,R10,R11,R12,R13,R14,R15], - %%(member(true,R)->( - aggregate_all(count, member(true,R), Count), - RA=[Count,Label].%%,writeln([Label,Count,"/10"]));true). - -trialy1(R1) :- - %%control11(A1), - trial0(A22), %% Control - sum(A22,0,S22), - mean(S22,A1), - trial0(A21), %% Test 1 - sum(A21,0,S02), - mean(S02,A2), - (A1>A2->R1=true;R1=fail). - -trial0(S3) :- N is 10, trial1(N,[],S),trial01(S,S3). -trial01(S1,S3) :- - sort(S1,S), - %%midpoint(S,MP), - halves(S,H1,H2), - midpoint(H1,Q1), - midpoint(H2,Q3), - IQR is Q3-Q1, - sum(S,0,S02), - mean(S02,Mean), - furthestfrommean(S,Mean,V), - D1 is 1.5*IQR, - D2 is V-Mean, - (D2>D1->(delete(S,V,S2),trial01(S2,S3));S=S3). - -trial1(0,A,A) :- !. -trial1(N,A,B) :- mindreadtest(S), append(A,[S],A2), - N1 is N-1,trial1(N1,A2,B). - -midpoint(S,MP) :- - length(S,L), - A is mod(L,2), - (A is 0-> - (M1 is L/2, M2 is M1+1,N1 is M1-1,N2 is M2-1,length(N11,N1),length(N21,N2),append(N11,[N12|_Rest1],S),append(N21,[N22|_Rest2],S),MP is (N12+N22)/2) - ; - (L2 is L+1, M1 is L2/2, N1 is M1-1,length(N11,N1),append(N11,[MP|_Rest],S))). - -halves(S,H1,H2) :- - length(S,L), - A is mod(L,2), - (A is 0-> - (M1 is L/2,length(H1,M1),append(H1,H2,S)) - ; - (L2 is L-1,M1 is L2/2,length(H1,M1),append(H1,[_|H2],S))). - -sum([],S,S):-!. -sum(S0,S1,S2) :- - S0=[S3|S4], - S5 is S1+S3, - sum(S4,S5,S2). - -mean(Sum,Mean) :- - Mean is Sum/2. - -furthestfrommean(S,Mean,V) :- - absdiffmean(S,Mean,[],D), - sort(D,D1), - reverse(D1,[[_,V]|_Rest]). - -absdiffmean([],_M,D,D) :- !. -absdiffmean(S,M,D1,D2) :- - S=[S1|S2], - S3 is abs(S1-M), - append(D1,[[S3,S1]],D3), - absdiffmean(S2,M,D3,D2). - -mindreadtest(Sec) :- - %% 250 br for characters to be br out with 10 br each from person to me - do when initial 250 br test done and doing 10 br test - %%comment(fiftyastest), - %%random(X),X1 is 10*X, X2 is floor(X1), (X2=<2 -> ( - %%texttobr,writeln(['true test']), %%); %% use breasonings breasoned out by computer for not by me, for job medicine for "me", at last time point - %%true), %% leave last time point blank - %%**texttobr2(640);true),%% make an A to detect reaction to gracious giving or blame of in following - get_time(TimeStamp1), - %%phrase_from_file(string(_String), 'file.txt'), - texttobr2(2), %% 100 As for answer (must be br before this on same day) - %% is gracious giving or blame - get_time(TimeStamp2), - %%comment(turnoffas), - Sec is TimeStamp2 - TimeStamp1. - -/**string(String) --> list(String). - -list([]) --> []. -list([L|Ls]) --> [L], list(Ls). - -comment(fiftyastest). -comment(turnoffas). -**/ \ No newline at end of file diff --git a/mindreadtestobj-12scrn-2medit.pl b/mindreadtestobj-12scrn-2medit.pl new file mode 100644 index 0000000..1bf2023 --- /dev/null +++ b/mindreadtestobj-12scrn-2medit.pl @@ -0,0 +1,102 @@ +%% mindreadtestobj-12scrn.pl + +%% *** Important: initialise program before running for the first time: +%% N is 2*2*3*5,texttobr2(N). %% 100 As for 2 (turned on then off)*2 (to and from computer)*3 (rb, itself (already done), graciously give or blame, radio button for graciously give or blame)*5 (5 objects) +%% also breason out and dot on objects before line above and breason out and dot on when recognising and saying object (with all objects having different breasonings) + +%% to recognise, think of stream of consciousness breasonings, the appearance of an object, words appearing and tricky appearances that mean something else + +%% teach subjects these skills telepathically one by one + +%% Before using, think 2 radio buttons put on recordings put through with prayer, nut and bolt, quantum box prayer, .01 .01 .005 .01 .01 .005 + +%% The algorithm has at (different x) times projected and identified my thought correctly but many of the figures are too similar + +%% br done on 25 5 19 for all time + +%% ideas: goats play board games against each other, they learn br, they ask questions and request games, the computer runs in real time and runs one game at a time, so they need to be scheduled. Also tournaments of br tests, maths, computer science, and games. Humanities texts come later. + +%% Sometimes I had the feeling of a quick representation taken from me before I could speak, people "talking for me" (in any case, a false reading) and other options appearing above mine, and sometimes breasonings I said "stickily" matching a different option from what I meant registered as the option + +%% The removal of interference with the interquartile range, increase to pointer to 100 done up As for projection and reading and breasoning preparation steps including As given to and doing breasoning out the answer led to better results + +%%use_module(library(pio)). + +:- use_module(library(date)). +:- include('mindreadtestshared'). +:- include('texttobr2qb'). + +%%sectest0 :- +%%repeat,sectest,sectest0. +sectest(S) :- sectest(7,0,S). +sectest(0,S,S):-!. +sectest(N,S1,S2):- + writeln(["The computer will think of one of the following thoughts when I let you know."]), + texttobr2(2), %% for 100 As for screen to display white background + texttobr2(2), %% for 100 As for screen to display A + sleep(5), + writeln(["characterbreasoner"]), + texttobr2(2), %% for 100 As for screen to display white background + texttobr2(2), %% for 100 As for screen to display A + sleep(5), + writeln(["1451"]), + texttobr2(2), %% for 100 As for screen to display white background + texttobr2(2), %% for 100 As for screen to display A + sleep(5), + writeln(["texttobr2"]), + texttobr2(2), %% for 100 As for screen to display white background + texttobr2(2), %% for 100 As for screen to display A + sleep(5), + writeln(["daily_regimen_meditation"]), + texttobr2(2), %% for 100 As for screen to display white background + texttobr2(2), %% for 100 As for screen to display A + sleep(5), + writeln(["list_prolog_interpreter"]), + texttobr2(2), %% for 100 As for screen to display white background + texttobr2(2), %% for 100 As for screen to display A + sleep(5), +/** writeln(["adrian"]), + texttobr2(2), %% for 100 As for screen to display white background + texttobr2(2), %% for 100 As for screen to display A + sleep(5), + **/ + writeln(["The computer will think of one of the following thoughts in 5 seconds.", "characterbreasoner","1451","texttobr2","daily_regimen_meditation","list_prolog_interpreter"/**,"adrian" + **/ + ]), + texttobr2(2), %% for 100 As for screen to display white background + texttobr2(2), %% for 100 As for screen to display A + sleep(5), + writeln(["Now"]), + sleep(1), + random_member(A,["characterbreasoner","1451","texttobr2","daily_regimen_meditation","list_prolog_interpreter" + /**,"adrian" + **/ + ]), + %%texttobr2(2), %% for 100 As for screen to display black border + texttobr2(2), %% for 100 As for screen to display white background + texttobr2(2), %% for 100 As for screen to display A + sleep(5), + writeln(["Think of the object the computer thought of in 1 second.", "characterbreasoner","1451","texttobr2","daily_regimen_meditation","list_prolog_interpreter"/**,"adrian" + **/ + ]), + texttobr2(2), %% for 100 As for screen to display white background + texttobr2(2), %% for 100 As for screen to display A + sleep(1), + %% Test thought here. + %%writeln(["Now"]), + %%get_time(TS),stamp_date_time(TS,T,local),writeln([dateandtime,T]), + trialy2_15("characterbreasoner",R1), + trialy2_15("1451",R2), + trialy2_15("texttobr2",R3), + trialy2_15("daily_regimen_meditation",R4), + trialy2_15("list_prolog_interpreter",R5), + R=[R1,R2,R3,R4,R5],%%,R6,R7,R8,R9,R10,R11,R12,R13,R14,R15,R16,R17,R18,R19,R20,R21,R22,R23,R24,R25,R26,R27], + sort(R,RA), + reverse(RA,RB), + RB=[[_,Item]|_Rest],writeln(["Computer thought",A,"You thought",Item]), + texttobr2(2), %% for 100 As for screen to display white background + texttobr2(2), %% for 100 As for screen to display A + sleep(15), + N1 is N-1,(A=Item->S3 is S1+1;S3=S1), + sectest(N1,S3,S2). + %%read_string(user_input,1,_). diff --git a/mindreadtestobj-12scrn-3.pl b/mindreadtestobj-12scrn-3.pl deleted file mode 100644 index 3662b90..0000000 --- a/mindreadtestobj-12scrn-3.pl +++ /dev/null @@ -1,195 +0,0 @@ -%% mindreadtestobj-12scrn.pl - -%% N is 2*2*3*6,texttobr2(N). %% 100 As for 2 (turned on then off)*2 (to and from computer)*3 (rb, itself (already done), graciously give or blame, radio button for graciously give or blame)*6 (6 objects) -%% then texttobr2(40).to turn off these with 250s before start - also breason out and dot on objects before line above and breason out and dot on when recognising and saying object (with all objects having different breasonings) - -%% to recognise, think of stream of consciousness breasonings, the appearance of an object, words appearing and tricky appearances that mean something else - -%% teach subjects these skills telepathically one by one - -%% Before using, think 2 radio buttons put on recordings put through with prayer, nut and bolt, quantum box prayer, .01 .01 .005 .01 .01 .005 - -%% The algorithm has at (different x) times projected and identified my thought correctly but many of the figures are too similar - -%% br done on 25 5 19 for all time - -%% ideas: goats play board games against each other, they learn br, they ask questions and request games, the computer runs in real time and runs one game at a time, so they need to be scheduled. Also tournaments of br tests, maths, computer science, and games. Humanities texts come later. - -%% Sometimes I had the feeling of a quick representation taken from me before I could speak, people "talking for me" (in any case, a false reading) and other options appearing above mine, and sometimes breasonings I said "stickily" matching a different option from what I meant registered as the option - -%% The removal of interference with the interquartile range, increase to pointer to 100 done up As for projection and reading and breasoning preparation steps including As given to and doing breasoning out the answer led to better results - -%%use_module(library(pio)). - -:- use_module(library(date)). -:- include('mindreadtestshared'). -:- include('texttobr2qb'). - -daysbspeoplearmy:- - daysbspeoplearmy(45), - daysbspeoplearmy(2). %% Give to people with graciously give or blame, radio button for graciously give or blame - -daysbspeoplearmy(0):-!. -daysbspeoplearmy(N1):- - texttobr2,N2 is N1-1,daysbspeoplearmy(N2). - -/** -control1:- - retractall(control11(_)), - writeln("Think of nothing for the next second"), - sleep(1), - trial0(A1), %% control1 - sleep(5), - sum(A1,0,S02), - mean(S02,A2), - assertz(control11(A2)). -**/ -%%sectest0 :- -%%repeat,sectest,sectest0. - -sectest:- - trialy2("seed",R1), - trialy2("water",R2), - trialy2("dam",R3), - trialy2("redblackduck",R4), - trialy2("lorelle",R5), - /**trialy2("adrian",R6), - trialy2("g",R7), - trialy2("h",R8), - trialy2("i",R9), - trialy2("j",R10), - trialy2("k",R11), - trialy2("l",R12), - trialy2("m",R13), - trialy2("n",R14), - trialy2("o",R15), - trialy2("p",R16), - trialy2("q",R17), - trialy2("r",R18), - trialy2("s",R19), - trialy2("t",R20), - trialy2("u",R21), - trialy2("v",R22), - trialy2("w",R23), - trialy2("x",R24), - trialy2("y",R25), - trialy2("z",R26), - trialy2(" ",R27),**/ - R=[R1,R2,R3,R4,R5],%%,R6,R7,R8,R9,R10,R11,R12,R13,R14,R15,R16,R17,R18,R19,R20,R21,R22,R23,R24,R25,R26,R27], - sort(R,RA), - reverse(RA,RB), - RB=[[_,Item]|_Rest],writeln(["You thought",Item]), - read_string(user_input,1,_), - sectest. - -trialy2(Label,RA) :- - %%writeln([testing,Label]), - trialy1(R1), - trialy1(R2), - trialy1(R3), - trialy1(R4), - trialy1(R5), - trialy1(R6), - trialy1(R7), - trialy1(R8), - trialy1(R9), - trialy1(R10), - trialy1(R11), - trialy1(R12), - trialy1(R13), - trialy1(R14), - trialy1(R15), - R=[R1,R2,R3,R4,R5,R6,R7,R8,R9,R10,R11,R12,R13,R14,R15], - %%(member(true,R)->( - aggregate_all(count, member(true,R), Count), - RA=[Count,Label].%%,writeln([Label,Count,"/10"]));true). - -trialy1(R1) :- - %%control11(A1), - trial0(A22), %% Control - sum(A22,0,S22), - mean(S22,A1), - trial0(A21), %% Test 1 - sum(A21,0,S02), - mean(S02,A2), - (A1>A2->R1=true;R1=fail). - -trial0(S3) :- N is 10, trial1(N,[],S),trial01(S,S3). -trial01(S1,S3) :- - sort(S1,S), - %%midpoint(S,MP), - halves(S,H1,H2), - midpoint(H1,Q1), - midpoint(H2,Q3), - IQR is Q3-Q1, - sum(S,0,S02), - mean(S02,Mean), - furthestfrommean(S,Mean,V), - D1 is 1.5*IQR, - D2 is V-Mean, - (D2>D1->(delete(S,V,S2),trial01(S2,S3));S=S3). - -trial1(0,A,A) :- !. -trial1(N,A,B) :- mindreadtest(S), append(A,[S],A2), - N1 is N-1,trial1(N1,A2,B). - -midpoint(S,MP) :- - length(S,L), - A is mod(L,2), - (A is 0-> - (M1 is L/2, M2 is M1+1,N1 is M1-1,N2 is M2-1,length(N11,N1),length(N21,N2),append(N11,[N12|_Rest1],S),append(N21,[N22|_Rest2],S),MP is (N12+N22)/2) - ; - (L2 is L+1, M1 is L2/2, N1 is M1-1,length(N11,N1),append(N11,[MP|_Rest],S))). - -halves(S,H1,H2) :- - length(S,L), - A is mod(L,2), - (A is 0-> - (M1 is L/2,length(H1,M1),append(H1,H2,S)) - ; - (L2 is L-1,M1 is L2/2,length(H1,M1),append(H1,[_|H2],S))). - -sum([],S,S):-!. -sum(S0,S1,S2) :- - S0=[S3|S4], - S5 is S1+S3, - sum(S4,S5,S2). - -mean(Sum,Mean) :- - Mean is Sum/2. - -furthestfrommean(S,Mean,V) :- - absdiffmean(S,Mean,[],D), - sort(D,D1), - reverse(D1,[[_,V]|_Rest]). - -absdiffmean([],_M,D,D) :- !. -absdiffmean(S,M,D1,D2) :- - S=[S1|S2], - S3 is abs(S1-M), - append(D1,[[S3,S1]],D3), - absdiffmean(S2,M,D3,D2). - -mindreadtest(Sec) :- - %% 250 br for characters to be br out with 10 br each from person to me - do when initial 250 br test done and doing 10 br test - %%comment(fiftyastest), - %%random(X),X1 is 10*X, X2 is floor(X1), (X2=<2 -> ( - %%texttobr,writeln(['true test']), %%); %% use breasonings breasoned out by computer for not by me, for job medicine for "me", at last time point - %%true), %% leave last time point blank - %%**texttobr2(640);true),%% make an A to detect reaction to gracious giving or blame of in following - get_time(TimeStamp1), - %%phrase_from_file(string(_String), 'file.txt'), - texttobr2(2), %% 100 As for answer (must be br before this on same day) - %% is gracious giving or blame - get_time(TimeStamp2), - %%comment(turnoffas), - Sec is TimeStamp2 - TimeStamp1. - -/**string(String) --> list(String). - -list([]) --> []. -list([L|Ls]) --> [L], list(Ls). - -comment(fiftyastest). -comment(turnoffas). -**/ \ No newline at end of file diff --git a/mindreadtestobj-12scrn.pl b/mindreadtestobj-12scrn.pl deleted file mode 100644 index 69c1b60..0000000 --- a/mindreadtestobj-12scrn.pl +++ /dev/null @@ -1,206 +0,0 @@ -%% mindreadtestobj-12scrn.pl - -%% N is 2*4*5,texttobr2(N). before for rb, 100 As for imagery etc appearing clearly to and from computer and with both with rb, itself, graciously give or blame, radio button for graciously give or blame, by 5 objects -%% then texttobr2(40).to turn off these with 250s before start - also breason out and dot on objects before line above and breason out and dot on when recognising and saying object (with all objects having different breasonings) - -%% to recognise, think of stream of consciousness breasonings, the appearance of an object, words appearing and tricky appearances that mean something else - -%% teach subjects these skills telepathically one by one - -%% Before using, think 2 radio buttons put on recordings put through with prayer, nut and bolt, quantum box prayer, .01 .01 .005 .01 .01 .005 - -%% The algorithm has at (different x) times projected and identified my thought correctly but many of the figures are too similar - -%% br done on 25 5 19 for all time - -%% ideas: goats play board games against each other, they learn br, they ask questions and request games, the computer runs in real time and runs one game at a time, so they need to be scheduled. Also tournaments of br tests, maths, computer science, and games. Humanities texts come later. - -%% Sometimes I had the feeling of a quick representation taken from me before I could speak, people "talking for me" (in any case, a false reading) and other options appearing above mine, and sometimes breasonings I said "stickily" matching a different option from what I meant registered as the option - -%% The removal of interference with the interquartile range, increase to pointer to 100 done up As for projection and reading and breasoning preparation steps including As given to and doing breasoning out the answer led to better results - -%%use_module(library(pio)). - -:- use_module(library(date)). -:- include('texttobr2qb'). - -daysbspeoplearmy:- - daysbspeoplearmy(45), - daysbspeoplearmy(2). %% Give to people with graciously give or blame, radio button for graciously give or blame - -daysbspeoplearmy(0):-!. -daysbspeoplearmy(N1):- - texttobr2,N2 is N1-1,daysbspeoplearmy(N2). - -control1:- - retractall(control11(_)), - writeln("Think of nothing for the next second"), - sleep(1), - trial0(A1), %% control1 - sleep(5), - sum(A1,0,S02), - mean(S02,A2), - assertz(control11(A2)). - -%%sectest0 :- -%%repeat,sectest,sectest0. -sectest:- - control1, - writeln(["Computer will think of one of following thoughts in 5 seconds\n", "seed","water","dam","redblackduck","lorelle"]), - sleep(4), - writeln(["Now"]), - sleep(1), - random_member(A,["seed","water","dam","redblackduck","lorelle"]), - texttobr2(2), %% for 100 As for screen to display black border - texttobr2(2), %% for 100 As for screen to display white background - texttobr2(2), %% for 100 As for screen to display A - sleep(5), - writeln(["Think of an object the computer thought of in 1 second\n", "seed","water","dam","redblackduck","lorelle"]), - sleep(1), - %% Test thought here. - %%writeln(["Now"]), - %%get_time(TS),stamp_date_time(TS,T,local),writeln([dateandtime,T]), - trialy2("seed",R1), - trialy2("water",R2), - trialy2("dam",R3), - trialy2("redblackduck",R4), - trialy2("lorelle",R5), - trialy2("adrian",R6), - /**trialy2("g",R7), - trialy2("h",R8), - trialy2("i",R9), - trialy2("j",R10), - trialy2("k",R11), - trialy2("l",R12), - trialy2("m",R13), - trialy2("n",R14), - trialy2("o",R15), - trialy2("p",R16), - trialy2("q",R17), - trialy2("r",R18), - trialy2("s",R19), - trialy2("t",R20), - trialy2("u",R21), - trialy2("v",R22), - trialy2("w",R23), - trialy2("x",R24), - trialy2("y",R25), - trialy2("z",R26), - trialy2(" ",R27),**/ - R=[R1,R2,R3,R4,R5,R6],%%,R7,R8,R9,R10,R11,R12,R13,R14,R15,R16,R17,R18,R19,R20,R21,R22,R23,R24,R25,R26,R27], - sort(R,RA), - reverse(RA,RB), - RB=[[_,Item]|_Rest],writeln(["Computer thought",A,"You thought",Item,"\nYou thought with first most likely\n",RB]). - %%read_string(user_input,1,_). - -trialy2(Label,RA) :- - %%writeln([testing,Label]), - trialy1(R1), - trialy1(R2), - trialy1(R3), - trialy1(R4), - trialy1(R5), - trialy1(R6), - trialy1(R7), - trialy1(R8), - trialy1(R9), - trialy1(R10), - trialy1(R11), - trialy1(R12), - trialy1(R13), - trialy1(R14), - trialy1(R15), - R=[R1,R2,R3,R4,R5,R6,R7,R8,R9,R10,R11,R12,R13,R14,R15], - %%(member(true,R)->( - aggregate_all(count, member(true,R), Count), - RA=[Count,Label].%%,writeln([Label,Count,"/10"]));true). - -trialy1(R1) :- - %%control11(A1), - trial0(A22), %% Control - sum(A22,0,S22), - mean(S22,A1), - trial0(A21), %% Test 1 - sum(A21,0,S02), - mean(S02,A2), - (A1>A2->R1=true;R1=fail). - -trial0(S3) :- N is 10, trial1(N,[],S),trial01(S,S3). -trial01(S1,S3) :- - sort(S1,S), - %%midpoint(S,MP), - halves(S,H1,H2), - midpoint(H1,Q1), - midpoint(H2,Q3), - IQR is Q3-Q1, - sum(S,0,S02), - mean(S02,Mean), - furthestfrommean(S,Mean,V), - D1 is 1.5*IQR, - D2 is V-Mean, - (D2>D1->(delete(S,V,S2),trial01(S2,S3));S=S3). - -trial1(0,A,A) :- !. -trial1(N,A,B) :- mindreadtest(S), append(A,[S],A2), - N1 is N-1,trial1(N1,A2,B). - -midpoint(S,MP) :- - length(S,L), - A is mod(L,2), - (A is 0-> - (M1 is L/2, M2 is M1+1,N1 is M1-1,N2 is M2-1,length(N11,N1),length(N21,N2),append(N11,[N12|_Rest1],S),append(N21,[N22|_Rest2],S),MP is (N12+N22)/2) - ; - (L2 is L+1, M1 is L2/2, N1 is M1-1,length(N11,N1),append(N11,[MP|_Rest],S))). - -halves(S,H1,H2) :- - length(S,L), - A is mod(L,2), - (A is 0-> - (M1 is L/2,length(H1,M1),append(H1,H2,S)) - ; - (L2 is L-1,M1 is L2/2,length(H1,M1),append(H1,[_|H2],S))). - -sum([],S,S):-!. -sum(S0,S1,S2) :- - S0=[S3|S4], - S5 is S1+S3, - sum(S4,S5,S2). - -mean(Sum,Mean) :- - Mean is Sum/2. - -furthestfrommean(S,Mean,V) :- - absdiffmean(S,Mean,[],D), - sort(D,D1), - reverse(D1,[[_,V]|_Rest]). - -absdiffmean([],_M,D,D) :- !. -absdiffmean(S,M,D1,D2) :- - S=[S1|S2], - S3 is abs(S1-M), - append(D1,[[S3,S1]],D3), - absdiffmean(S2,M,D3,D2). - -mindreadtest(Sec) :- - %% 250 br for characters to be br out with 10 br each from person to me - do when initial 250 br test done and doing 10 br test - %%comment(fiftyastest), - %%random(X),X1 is 10*X, X2 is floor(X1), (X2=<2 -> ( - %%texttobr,writeln(['true test']), %%); %% use breasonings breasoned out by computer for not by me, for job medicine for "me", at last time point - %%true), %% leave last time point blank - %%**texttobr2(640);true),%% make an A to detect reaction to gracious giving or blame of in following - get_time(TimeStamp1), - %%phrase_from_file(string(_String), 'file.txt'), - texttobr2(2), %% 100 As for answer (must be br before this on same day) - %% is gracious giving or blame - get_time(TimeStamp2), - %%comment(turnoffas), - Sec is TimeStamp2 - TimeStamp1. - -/**string(String) --> list(String). - -list([]) --> []. -list([L|Ls]) --> [L], list(Ls). - -comment(fiftyastest). -comment(turnoffas). -**/ \ No newline at end of file diff --git a/mindreadtestshared.pl b/mindreadtestshared.pl index b1d7009..f25c079 100644 --- a/mindreadtestshared.pl +++ b/mindreadtestshared.pl @@ -1,11 +1,3 @@ -daysbspeoplearmy:- - daysbspeoplearmy(2), %% 3 days, 3 people, a b bb, seen as version, hq version, army go, army return - daysbspeoplearmy(2). %% Give to people with gg or b, rb - -daysbspeoplearmy(0):-!. -daysbspeoplearmy(N1):- - texttobr2,N2 is N1-1,daysbspeoplearmy(N2). - %% Name, DOB, Date learned, psych appointment month=1 or 2, psych appointment day, thoughts count sectest0 :- @@ -230,6 +222,88 @@ aggregate_all(count, member(true,R), Count), RA=[Count,Label].%%,writeln([Label,Count,"/10"]));true). + +trialy1(R1) :- + %%control11(A1), + trial0(A22), %% Control + sum(A22,0,S22), + mean(S22,A1), + trial0(A21), %% Test 1 + sum(A21,0,S02), + mean(S02,A2), + (A1>A2->R1=true;R1=fail). + +trial0(S3) :- N is 10, trial1(N,[],S),trial01(S,S3). +trial01(S1,S3) :- + sort(S1,S), + %%midpoint(S,MP), + halves(S,H1,H2), + midpoint(H1,Q1), + midpoint(H2,Q3), + IQR is Q3-Q1, + sum(S,0,S02), + mean(S02,Mean), + furthestfrommean(S,Mean,V), + D1 is 1.5*IQR, + D2 is V-Mean, + (D2>D1->(delete(S,V,S2),trial01(S2,S3));S=S3). + +trial1(0,A,A) :- !. +trial1(N,A,B) :- mindreadtest(S), append(A,[S],A2), + N1 is N-1,trial1(N1,A2,B). + +midpoint(S,MP) :- + length(S,L), + A is mod(L,2), + (A is 0-> + (M1 is L/2, M2 is M1+1,N1 is M1-1,N2 is M2-1,length(N11,N1),length(N21,N2),append(N11,[N12|_Rest1],S),append(N21,[N22|_Rest2],S),MP is (N12+N22)/2) + ; + (L2 is L+1, M1 is L2/2, N1 is M1-1,length(N11,N1),append(N11,[MP|_Rest],S))). + +halves(S,H1,H2) :- + length(S,L), + A is mod(L,2), + (A is 0-> + (M1 is L/2,length(H1,M1),append(H1,H2,S)) + ; + (L2 is L-1,M1 is L2/2,length(H1,M1),append(H1,[_|H2],S))). + +sum([],S,S):-!. +sum(S0,S1,S2) :- + S0=[S3|S4], + S5 is S1+S3, + sum(S4,S5,S2). + +mean(Sum,Mean) :- + Mean is Sum/2. + +furthestfrommean(S,Mean,V) :- + absdiffmean(S,Mean,[],D), + sort(D,D1), + reverse(D1,[[_,V]|_Rest]). + +absdiffmean([],_M,D,D) :- !. +absdiffmean(S,M,D1,D2) :- + S=[S1|S2], + S3 is abs(S1-M), + append(D1,[[S3,S1]],D3), + absdiffmean(S2,M,D3,D2). + +mindreadtest(Sec) :- + %% 250 br for characters to be br out with 10 br each from person to me - do when initial 250 br test done and doing 10 br test + %%comment(fiftyastest), + %%random(X),X1 is 10*X, X2 is floor(X1), (X2=<2 -> ( + %%texttobr,writeln(['true test']), %%); %% use breasonings breasoned out by computer for not by me, for job medicine for "me", at last time point + %%true), %% leave last time point blank + %%**texttobr2(640);true),%% make an A to detect reaction to gracious giving or blame of in following + get_time(TimeStamp1), + %%phrase_from_file(string(_String), 'file.txt'), + texttobr2(2), %% 100 As for answer (must be br before this on same day) + %% is gracious giving or blame + get_time(TimeStamp2), + %%comment(turnoffas), + Sec is TimeStamp2 - TimeStamp1. + shell1(Command) :- (bash_command(Command,_)-> true;